9 from Data.Func import $
10 from Text import class Text(..), instance Text String
15 commands = map toString
17 ,USER "cloogle" 0 "Cloogle bot"
18 ,JOIN [("#cloogle", Nothing)]
21 TIMEOUT :== Just 10000
22 SERVER :== "irc.freenode.net"
24 KEY :== "PRIVMSG #cloogle :!"
26 send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
27 send [] chan w = (chan, w)
28 send [msg:msgs] {sChannel,rChannel} w
29 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
30 | rpt <> TR_Success = abort "Could not send request\n"
31 = send msgs {sChannel=sChannel,rChannel=rChannel} w
33 recv :: TCP_DuplexChannel *World -> (Maybe String, TCP_DuplexChannel, *World)
34 recv {sChannel,rChannel} w
35 # (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
36 | rpt == TR_Expired = (Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
37 | rpt == TR_NoSuccess || isNothing resp = abort "Halp?\n"
38 = (toString <$> resp, {sChannel=sChannel,rChannel=rChannel}, w)
40 msg :: (String -> IRCCommands)
41 msg = PRIVMSG "#cloogle"
43 process :: *File TCP_DuplexChannel *World -> (*File, TCP_DuplexChannel, *World)
45 # (mr, chan, w) = recv chan w
46 | isNothing mr = process io chan w
48 #! io = io <<< ("Received: " +++ resp +++ "\n")
49 # ind = indexOf KEY resp
51 # cmd = split " " $ rtrim $ subString (ind + size KEY) (size resp - ind) resp
52 #! io = io <<< ("Received command: " +++ printToString cmd +++ "\n")
53 # toSend = case cmd of
55 ["ping":_] = Just [msg "pong"]
56 ["help":_] = Just [msg "not implemented yet"]
57 [c:_] = Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]]
58 | isNothing toSend = (io, chan, w)
59 # (chan, w) = send (map toString $ fromJust toSend) chan w
63 Start :: *World -> *World
66 # (ip, w) = lookupIPAddress SERVER w
67 | isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
69 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
70 | rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
71 | rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
72 # chan = fromJust chan
73 # (chan, w) = send commands chan w
74 # (io, chan, w) = process io chan w
75 # ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
76 # (_, w) = fclose io w
77 = closeChannel sChannel (closeRChannel rChannel w)