cloogle.icl

   1 module cloogle
   2
   3 import GenPrint
   4 import IRC
   5 import StdEnv
   6
   7 import Data.Functor
   8 import Data.Maybe
   9 from Data.Func import $
  10 from Text import class Text(..), instance Text String
  11
  12 import TCPIP
  13
  14 commands :: [String]
  15 commands = map toString
  16         [NICK "clooglebot"
  17         ,USER "cloogle" 0 "Cloogle bot"
  18         ,JOIN [("#cloogle", Nothing)]
  19         ]
  20
  21 TIMEOUT :== Just 10000
  22 SERVER :== "irc.freenode.net"
  23
  24 KEY :== "PRIVMSG #cloogle :!"
  25
  26 shorten :: String *World -> (String, *World)
  27 shorten s w = ("not implemented yet", w)
  28
  29 send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
  30 send [] chan w = (chan, w)
  31 send [msg:msgs] {sChannel,rChannel} w
  32 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
  33 | rpt <> TR_Success = abort "Could not send request\n"
  34 = send msgs {sChannel=sChannel,rChannel=rChannel} w
  35
  36 recv :: TCP_DuplexChannel *World -> (Maybe String, TCP_DuplexChannel, *World)
  37 recv {sChannel,rChannel} w
  38 # (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
  39 | rpt == TR_Expired = (Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
  40 | rpt == TR_NoSuccess || isNothing resp = abort "Halp?\n"
  41 = (toString <$> resp, {sChannel=sChannel,rChannel=rChannel}, w)
  42
  43 msg :: (String -> IRCCommands)
  44 msg = PRIVMSG "#cloogle"
  45
  46 process :: *File TCP_DuplexChannel *World -> (*File, TCP_DuplexChannel, *World)
  47 process io chan w
  48 # (mr, chan, w) = recv chan w
  49 | isNothing mr = process io chan w
  50 # resp = fromJust mr
  51 #! io = io <<< ("Received: " +++ resp +++ "\n")
  52 # ind = indexOf KEY resp
  53 | ind >= 0
  54         # cmd = split " " $ rtrim $ subString (ind + size KEY) (size resp) resp
  55         #! io =  io <<< ("Received command: " +++ printToString cmd +++ "\n")
  56         # (w, toSend) = case cmd of
  57                 ["stop":_] = (w, Nothing)
  58                 ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs])
  59                 ["short"] = (w, Just [msg $ "short requires an url argument"])
  60                 ["short":xs]
  61                         # (s, w) = shorten (join " " xs) w
  62                         = (w, Just [msg s])
  63                 ["help"] = (w, Just
  64                         [msg "type !help cmd for command specific help"
  65                         ,msg "available commands: help, short, ping"])
  66                 ["help":c:_] = (w, case c of
  67                         "help"  = Just [msg "help  [CMD] - I will print general help or the help of CMD"]
  68                         "short" = Just [msg "short  URL  - I will give the url to https://cloo.gl shortening service and post back the result"]
  69                         "ping"  = Just [msg "ping  [TXT] - I will reply with pong and the optionar TXT"]
  70                         _ = Just [msg "Unknown command"])
  71                 [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ",  type !help to get help"]])
  72         | isNothing toSend = (io, chan, w)
  73         # (chan, w) = send (map toString $ fromJust toSend) chan w
  74         = process io chan w
  75 | indexOf "PING :" resp >= 0
  76         # cmd = rtrim $ subString (indexOf "PING :" resp + size "PING :") (size resp) resp
  77         #! io = io <<< (toString $ PONG cmd Nothing) <<< "\n"
  78         # (chan, w) = send [toString $ PONG cmd Nothing] chan w
  79         = process io chan w
  80 = process io chan w
  81
  82 Start :: *World -> *World
  83 Start w
  84 # (io, w) = stdio w
  85 # (ip, w) = lookupIPAddress SERVER w
  86 | isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
  87 # (Just ip) = ip
  88 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
  89 | rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
  90 | rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
  91 # chan = fromJust chan
  92 # (chan, w) = send commands chan w
  93 # (io, chan, w) = process io chan w
  94 # ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
  95 # (_, w) = fclose io w
  96 = closeChannel sChannel (closeRChannel rChannel w)