From: Mart Lubbers Date: Tue, 3 Apr 2018 10:25:11 +0000 (+0200) Subject: update bot to work with clean-selectloop X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=998c6376312382e65d05473c5778d6ac63add47f;p=cloogle-irc.git update bot to work with clean-selectloop --- diff --git a/.gitmodules b/.gitmodules index 681a9b6..d9caef9 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,6 @@ [submodule "libcloogle"] path = libcloogle url = https://github.com/clean-cloogle/libcloogle.git +[submodule "clean-selectloop"] + path = clean-selectloop + url = https://github.com/dopefishh/clean-selectloop.git diff --git a/IRCBot.dcl b/IRCBot.dcl index 06d8e7f..a016649 100644 --- a/IRCBot.dcl +++ b/IRCBot.dcl @@ -24,4 +24,5 @@ from Data.Error import :: MaybeErrorString, :: MaybeError * param: World * return: Maybe an error, the state and the new world */ -bot :: (String, Int) [IRCMessage] [IRCMessage] .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> *(Maybe String, .a, *World) +bot :: (String,Int) [IRCMessage] [IRCMessage] a (IRCMessage -> a -> .(*World -> *(Maybe [IRCMessage],a,*World))) *World -> *(Maybe String,a,*World) +//bot :: (String, Int) [IRCMessage] [IRCMessage] .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> *(Maybe String, .a, *World) diff --git a/IRCBot.icl b/IRCBot.icl index e2e7d11..3d5c156 100644 --- a/IRCBot.icl +++ b/IRCBot.icl @@ -5,81 +5,31 @@ import Data.Either import Data.Error import Data.Maybe import IRC -import TCPIP - -from Text import class Text(split,join), instance Text String - -import StdList -import StdBool - -TIMEOUT :== Just 1000 - -bot :: (String, Int) [IRCMessage] [IRCMessage] .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> *(Maybe String, .a, *World) -bot (host, port) start end state bot w -//Lookup hostname -# (ip, w) = lookupIPAddress host w -| isNothing ip - = (Just $ "DNS lookup for " +++ host +++ " failed", state, w) -//Connect -# (rpt,chan,w) = connectTCP_MT TIMEOUT (fromJust ip, port) w -| rpt == TR_Expired - = (Just $ "Connection to " +++ host +++ " timed out", state, w) -| rpt == TR_NoSuccess - = (Just $ "Could not connect to " +++ host, state, w) -// Send startup commands -# (merr, chan, w) = send (map toString start) (fromJust chan) w -| isError merr = (Just $ fromError merr, state, w) -//Start processing function -# (mer, chan, state, w) = process chan "" state bot w -| isError mer = (Just $ fromError mer, state, w) -// Send shutdown commands -# (merr, {rChannel,sChannel}, w) = send (map toString end) chan w -| isError merr = (Just $ fromError merr, state, w) -//Close channels -= (Nothing, state, closeChannel sChannel (closeRChannel rChannel w)) - -process :: TCP_DuplexChannel String .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> (MaybeErrorString (), TCP_DuplexChannel, .a, *World) -process chan acc state bot w -//See if we have a message -= case split "\r\n" acc of - //We only have one message that is not complete - [m] - //Receive - # (merr_resp, chan, w) = recv chan w - | isError merr_resp = (Error (fromError merr_resp), chan, state, w) - # (Ok mresp) = merr_resp - | isNothing mresp = process chan acc state bot w - = process chan (m +++ fromJust mresp) state bot w - //We have a successfull split and therefore we process at least one message - [m:xs] - # acc = join "\r\n" xs - = case parseIRCMessage $ m +++ "\r\n" of - (Left err) = (Error $ "IRC Parsing error: " +++ join "\n" err, chan, state, w) - (Right msg) - # (mircc, state, w) = bot msg state w - | isNothing mircc = (Ok (), chan, state, w) // Bot asks to quit - //Possible send the commands - # (merr, chan, w) = send (map toString $ fromJust mircc) chan w - | isError merr = (Error $ fromError merr, chan, state, w) - //Recurse - = process chan acc state bot w - -send :: ![String] !TCP_DuplexChannel !*World -> (!MaybeErrorString (), !TCP_DuplexChannel, !*World) -send [] chan w = (Ok (), chan, w) -send [msg:msgs] {sChannel,rChannel} w -# (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w -| rpt <> TR_Success = (Error "Could not send message", {sChannel=sChannel,rChannel=rChannel}, w) -//# (_, w) = sleep 500000 w -= send msgs {sChannel=sChannel,rChannel=rChannel} w -// where -// sleep :: !Int !*World -> (!Int, *World) -// sleep i w = code { -// ccall usleep "I:I:A" -// } - -recv :: TCP_DuplexChannel *World -> (MaybeErrorString (Maybe String), TCP_DuplexChannel, *World) -recv {sChannel,rChannel} w -# (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w -| rpt == TR_Expired = (Ok Nothing, {sChannel=sChannel,rChannel=rChannel}, w) -| rpt == TR_NoSuccess || isNothing resp = (Error "Timeout recv fail", {sChannel=sChannel,rChannel=rChannel}, w) -= (Ok $ Just $ toString $ fromJust resp, {sChannel=sChannel,rChannel=rChannel}, w) +from Text import class Text(concat,split,join), instance Text String +import StdList, StdString +import TCPServer.Connection + +bot :: (String,Int) [IRCMessage] [IRCMessage] a (IRCMessage -> a -> .(*World -> *(Maybe [IRCMessage],a,*World))) *World -> *(Maybe String,a,*World) +//bot :: (String, Int) [IRCMessage] [IRCMessage] .a (IRCMessage -> (.a -> .(*World -> *(Maybe [IRCMessage], .a, *World)))) *World -> *(Maybe String, .a, *World) +bot (host, port) start end state bot w = case connect host port + { emptyConnection + & onConnect = onConnect + , onData = onData + } ("", state) w of + (Error e, w) = (Just e, state, w) + (Ok (acc, state), w) = (Nothing, state, w) +where + onConnect s w = (Just (concat (map toString start)), connectionResponse s, w) + onData d (acc, s) w = case split "\r\n" (acc +++ d) of + [m,rest:xs] + = case parseIRCMessage $ m +++ "\r\n" of + // Do something with the error + (Left err) = (Nothing, {connectionResponse ("", s) & stop=True}, w)// (Error $ "IRC Parsing error: " +++ join "\n" err, chan, state, w) + (Right msg) + # acc = join "\r\n" [rest:xs] + # (mircc, state, w) = bot msg state w + | isNothing mircc = (Just (concat (map toString end)), {connectionResponse (acc, s) & stop=True}, w) + # tosendthis = concat (map toString (fromJust mircc)) + # (tosend, cr, w) = onData "" (acc, s) w + = (Just (maybe tosendthis ((+++) tosendthis) tosend), cr, w) + [m] = (Nothing, connectionResponse (m, s), w) diff --git a/Makefile b/Makefile index b1b934b..d6a5ac8 100644 --- a/Makefile +++ b/Makefile @@ -2,10 +2,6 @@ CLEAN_HOME?=/opt/clean CLM:=clm override CLMFLAGS+=-nt -GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6) -ifeq "$(GCCVERSIONGTEQ6)" "1" - override CLMFLAGS+=-l -no-pie -endif CLMLIBS:=\ -I $(CLEAN_HOME)/lib/Platform\ @@ -13,7 +9,8 @@ CLMLIBS:=\ -I $(CLEAN_HOME)/lib/Generics\ -I $(CLEAN_HOME)/lib/TCPIP\ -I $(CLEAN_HOME)/lib/Dynamics\ - -I ./libcloogle + -I ./libcloogle\ + -I ./clean-selectloop/libraries BINARIES:=IRC IRCBot cloogleirc #test diff --git a/clean-selectloop b/clean-selectloop new file mode 160000 index 0000000..bca216d --- /dev/null +++ b/clean-selectloop @@ -0,0 +1 @@ +Subproject commit bca216df4847e45d5b77d02c7302340b7a0dcf30 diff --git a/cloogleirc.icl b/cloogleirc.icl index 3f0ac55..534a57a 100644 --- a/cloogleirc.icl +++ b/cloogleirc.icl @@ -1,7 +1,7 @@ module cloogleirc import Cloogle -import Data.Generics.GenPrint +import Text.GenPrint import StdEnv import Data.Functor @@ -12,7 +12,7 @@ from Text import class Text(..), instance Text String, instance + String import Internet.HTTP -import Text.JSON +import Text.GenJSON import Text.URI import System.Time @@ -118,8 +118,9 @@ Start w # io = io <<< fromError bs <<< "\n" = (Nothing, snd $ fclose io w) # (Ok bs) = bs -# (merr, io, w) = bot (bs.bs_server, bs.bs_port) (startup bs) shutdown io (process bs.bs_strftime) w -= (merr, snd $ fclose io w) +# (_, w) = fclose io w +# (merr, _, w) = bot (bs.bs_server, bs.bs_port) (startup bs) shutdown () (process bs.bs_strftime) w += (merr, w) where parseCLI :: String [String] -> MaybeErrorString BotSettings parseCLI _ [] = Ok @@ -172,17 +173,18 @@ Start w [JOIN (CSepList bs.bs_autojoin) Nothing] shutdown = map toPrefix [QUIT $ Just "Bye"] - process :: String !IRCMessage *File !*World -> (Maybe [IRCMessage], *File, !*World) - process strf im io w - #! (io, w) = log strf " (r): " im (io, w) + process :: String !IRCMessage () !*World -> (Maybe [IRCMessage], (), !*World) + process strf im _ w + # (io ,w) = stdio w + # (io, w) = log strf " (r): " im (io, w) + # (_, w) = fclose io w = case im.irc_command of - Left numr = (Just [], io, w) + Left numr = (Just [], (), w) Right cmd = case process` im.irc_prefix cmd w of - (Nothing, w) = (Nothing, io, w) + (Nothing, w) = (Nothing, (), w) (Just cs, w) # msgs = map toPrefix cs -// #! (io, w) = foldr (log strf " (s): ") (io, w) msgs - = (Just msgs, io, w) + = (Just msgs, (), w) log :: String String IRCMessage (!*File, !*World) -> (!*File, !*World) log strf pref m (io, w) diff --git a/libcloogle b/libcloogle index 04ca6f2..fd55013 160000 --- a/libcloogle +++ b/libcloogle @@ -1 +1 @@ -Subproject commit 04ca6f2158881c65bcec32d1a9c6d521a1316181 +Subproject commit fd55013666160619318dcabbf562ae4aa09a529d