IRCBot.icl

   1 implementation module IRCBot
   2
   3 from Data.Func import $
   4 import Data.Either
   5 import Data.Error
   6 import Data.Maybe
   7 import IRC
   8 import TCPIP
   9
  10 from Text import class Text(split,join), instance Text String
  11
  12 import StdList
  13 import StdBool
  14
  15 TIMEOUT :== Just 1000
  16
  17 bot :: (String, Int) [IRCMessage] [IRCMessage] .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> *(Maybe String, .a, *World)
  18 bot (host, port) start end state bot w
  19 //Lookup hostname
  20 # (ip, w) = lookupIPAddress host w
  21 | isNothing ip
  22         = (Just $ "DNS lookup for " +++ host +++ " failed", state, w)
  23 //Connect
  24 # (rpt,chan,w) = connectTCP_MT TIMEOUT (fromJust ip, port) w
  25 | rpt == TR_Expired
  26         = (Just $ "Connection to " +++ host +++ " timed out", state, w)
  27 | rpt == TR_NoSuccess
  28         = (Just $ "Could not connect to " +++ host, state, w)
  29 // Send startup commands
  30 # (merr, chan, w) = send [toString s +++ "\r\n" \\ s <- start] (fromJust chan) w
  31 | isError merr = (Just $ fromError merr, state, w)
  32 //Start processing function
  33 # (mer, chan, state, w) = process chan "" state bot w
  34 | isError mer = (Just $ fromError mer, state, w)
  35 // Send shutdown commands
  36 # (merr, {rChannel,sChannel}, w) = send (map toString end) chan w
  37 | isError merr = (Just $ fromError merr, state, w)
  38 //Close channels
  39 = (Nothing, state, closeChannel sChannel (closeRChannel rChannel w))
  40
  41 process :: TCP_DuplexChannel String .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> (MaybeErrorString (), TCP_DuplexChannel, .a, *World)
  42 process chan acc state bot w
  43 //See if we have a message
  44 = case split "\r\n" acc of
  45         //We only have one message that is not complete
  46         [m]
  47                 //Receive
  48                 # (merr_resp, chan, w) = recv chan w
  49                 | isError merr_resp = (Error (fromError merr_resp), chan, state, w)
  50                 # (Ok mresp) = merr_resp
  51                 | isNothing mresp = process chan acc state bot w
  52                 = process chan (m +++ fromJust mresp) state bot w
  53         //We have a successfull split and therefore we process at least one message
  54         [m:xs]
  55                 # acc = join "\r\n" xs
  56                 = case parseIRCMessage $ m +++ "\r\n" of
  57                         (Left err) = (Error $ "IRC Parsing error: " +++ join "\n" err, chan, state, w)
  58                         (Right msg)
  59                         # (mircc, state, w) = bot msg state w
  60                         | isNothing mircc = (Ok (), chan, state, w) // Bot asks to quit
  61                         //Possible send the commands
  62                         # (merr, chan, w) = send [toString c +++ "\r\n" \\ c <- fromJust mircc] chan w
  63                         | isError merr = (Error $ fromError merr, chan, state, w)
  64                         //Recurse
  65                         = process chan acc state bot w
  66
  67 send :: ![String] !TCP_DuplexChannel !*World -> (!MaybeErrorString (), !TCP_DuplexChannel, !*World)
  68 send [] chan w = (Ok (), chan, w)
  69 send [msg:msgs] {sChannel,rChannel} w
  70 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
  71 | rpt <> TR_Success = (Error "Could not send message", {sChannel=sChannel,rChannel=rChannel}, w)
  72 # (_, w) = sleep 500000 w
  73 = send msgs {sChannel=sChannel,rChannel=rChannel} w
  74         where
  75                 sleep :: !Int !*World -> (!Int, *World)
  76                 sleep i w = code {
  77                                 ccall usleep "I:I:A"
  78                         }
  79
  80 recv :: TCP_DuplexChannel *World -> (MaybeErrorString (Maybe String), TCP_DuplexChannel, *World)
  81 recv {sChannel,rChannel} w
  82 # (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
  83 | rpt == TR_Expired = (Ok Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
  84 | rpt == TR_NoSuccess || isNothing resp = (Error "Timeout recv fail", {sChannel=sChannel,rChannel=rChannel}, w)
  85 = (Ok $ Just $ toString $ fromJust resp, {sChannel=sChannel,rChannel=rChannel}, w)