proof of concept minimal cloogle bot

diff --git a/.gitignore b/.gitignore
index e457cd8..3830998 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 test
 Clean System Files
+cloogle

diff --git a/Makefile b/Makefile
index 19086b6..52e804e 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -14,7 +14,7 @@ CLMLIBS:=\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I $(CLEAN_HOME)/lib/Dynamics\
 
-BINARIES:=test
+BINARIES:=test cloogle
 
 all: $(BINARIES)
 

diff --git a/cloogle.icl b/cloogle.icl
new file mode 100644 (file)
index 0000000..f933b2b
--- /dev/null
+++ b/cloogle.icl
@@ -0,0 +1,77 @@
+module cloogle
+
+import GenPrint
+import IRC
+import StdEnv
+
+import Data.Functor
+import Data.Maybe
+from Data.Func import $
+from Text import class Text(..), instance Text String
+
+import TCPIP
+
+commands :: [String]
+commands = map toString
+       [NICK "clooglebot"
+       ,USER "cloogle" 0 "Cloogle bot"
+       ,JOIN [("#cloogle", Nothing)]
+       ]
+
+TIMEOUT :== Just 10000
+SERVER :== "irc.freenode.net"
+
+KEY :== "PRIVMSG #cloogle :!"
+
+send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
+send [] chan w = (chan, w)
+send [msg:msgs] {sChannel,rChannel} w
+# (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
+| rpt <> TR_Success = abort "Could not send request\n"
+= send msgs {sChannel=sChannel,rChannel=rChannel} w
+
+recv :: TCP_DuplexChannel *World -> (Maybe String, TCP_DuplexChannel, *World)
+recv {sChannel,rChannel} w
+# (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
+| rpt == TR_Expired = (Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
+| rpt == TR_NoSuccess || isNothing resp = abort "Halp?\n"
+= (toString <$> resp, {sChannel=sChannel,rChannel=rChannel}, w)
+
+msg :: (String -> IRCCommands)
+msg = PRIVMSG "#cloogle"
+
+process :: *File TCP_DuplexChannel *World -> (*File, TCP_DuplexChannel, *World)
+process io chan w 
+# (mr, chan, w) = recv chan w
+| isNothing mr = process io chan w
+# resp = fromJust mr
+#! io = io <<< ("Received: " +++ resp +++ "\n")
+# ind = indexOf KEY resp
+| ind > 0
+       # cmd = split " " $ rtrim $ subString (ind + size KEY) (size resp - ind) resp
+       #! io =  io <<< ("Received command: " +++ printToString cmd +++ "\n")
+       # toSend = case cmd of
+               ["stop":_] = Nothing
+               ["ping":_] = Just [msg "pong"]
+               ["help":_] = Just [msg "not implemented yet"]
+               [c:_] = Just [msg $ join " " ["unknown command: " , c, ",  type !help to get help"]]
+       | isNothing toSend = (io, chan, w)
+       # (chan, w) = send (map toString $ fromJust toSend) chan w
+       = process io chan w
+= process io chan w
+
+Start :: *World -> *World
+Start w
+# (io, w) = stdio w
+# (ip, w) = lookupIPAddress SERVER w
+| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
+# (Just ip) = ip
+# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
+| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
+| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
+# chan = fromJust chan
+# (chan, w) = send commands chan w
+# (io, chan, w) = process io chan w
+# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
+# (_, w) = fclose io w
+= closeChannel sChannel (closeRChannel rChannel w)