From: Mart Lubbers <mart@martlubbers.net>
Date: Sun, 5 Mar 2017 13:58:41 +0000 (+0100)
Subject: proof of concept minimal cloogle bot
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=c889f42c8845390b3ba7e65b7c28fbe71c7ac374;p=cloogle-irc.git

proof of concept minimal cloogle bot
---

diff --git a/.gitignore b/.gitignore
index e457cd8..3830998 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 test
 Clean System Files
+cloogle
diff --git a/Makefile b/Makefile
index 19086b6..52e804e 100644
--- 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
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)