From e81450dc6e427524ac74160cc9d54b1d8fb40cba Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 24 Jul 2017 14:13:09 +0200 Subject: [PATCH] compiles, but doesn't work, probably strictness? --- .gitignore | 2 ++ IRCBot.dcl | 2 +- IRCBot.icl | 28 ++++++++++++++-------------- Makefile | 4 ++-- cloogleirc.icl | 19 +++++++------------ test.icl | 20 -------------------- 6 files changed, 26 insertions(+), 49 deletions(-) delete mode 100644 test.icl diff --git a/.gitignore b/.gitignore index 29de276..b7a24d7 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ test Clean System Files cloogleirc IRC +IRCBot +cloogle diff --git a/IRCBot.dcl b/IRCBot.dcl index f0f0af2..06d8e7f 100644 --- a/IRCBot.dcl +++ b/IRCBot.dcl @@ -24,4 +24,4 @@ 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) diff --git a/IRCBot.icl b/IRCBot.icl index df21c0a..3b62090 100644 --- a/IRCBot.icl +++ b/IRCBot.icl @@ -14,31 +14,31 @@ import StdBool TIMEOUT :== Just 1000 -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 //Lookup hostname # (ip, w) = lookupIPAddress host w | isNothing ip - = (Just $ "DNS lookup for " +++ host +++ " failed", (state, w)) + = (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)) + = (Just $ "Connection to " +++ host +++ " timed out", state, w) | rpt == TR_NoSuccess - = (Just $ "Could not connect to " +++ host, (state, w)) + = (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)) +| 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)) +| 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)) +| isError merr = (Just $ fromError merr, state, w) //Close channels -= (Nothing, (state, closeChannel sChannel (closeRChannel rChannel w))) += (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 :: 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 @@ -46,21 +46,21 @@ process chan acc state bot w [m] //Receive # (merr_resp, chan, w) = recv chan w - | isError merr_resp = (Error (fromError merr_resp), chan, (state, 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 + = 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 + # (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)) + | isError merr = (Error $ fromError merr, chan, state, w) //Recurse = process chan acc state bot w diff --git a/Makefile b/Makefile index 3e08ebb..80b0c7e 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ CLEAN_HOME?=/opt/clean CLM:=clm -override CLMFLAGS+=-nt -dynamics -lat +override CLMFLAGS+=-nt -dynamics -lat -d -nsa -nou GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6) ifeq "$(GCCVERSIONGTEQ6)" "1" override CLMFLAGS+=-l -no-pie @@ -15,7 +15,7 @@ CLMLIBS:=\ -I $(CLEAN_HOME)/lib/Dynamics\ -I ./libcloogle -BINARIES:=IRC cloogleirc #test +BINARIES:=IRC IRCBot cloogleirc #test all: $(BINARIES) diff --git a/cloogleirc.icl b/cloogleirc.icl index a83663b..46c20f1 100644 --- a/cloogleirc.icl +++ b/cloogleirc.icl @@ -33,9 +33,6 @@ import TCPIP import IRC import IRCBot -TIMEOUT :== Just 10000 -SERVER :== "irc.freenode.net" - shorten :: String *World -> (String, *World) shorten s w # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s)) @@ -95,9 +92,7 @@ cloogle data w = join "\n" (map maxWidth lines) maxWidth :: String -> String - maxWidth s - | size s > 80 = subString 0 77 s + "..." - = s + maxWidth s = if (size s > 80) (subString 0 77 s + "...") s :: BotSettings = { bs_nick :: String @@ -113,10 +108,10 @@ Start w # ([arg0:args], w) = getCommandLine w # (io, w) = stdio w # bs = parseCLI args -| isError bs = (Just $ "\n" +++ fromError bs +++ "\n", snd $ fclose io w) +//| isError bs = (Just $ "\n" +++ fromError bs +++ "\n", 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) += (Nothing, w)//= (merr, snd $ fclose io w) where parseCLI :: [String] -> MaybeErrorString BotSettings parseCLI [] = Ok @@ -169,7 +164,7 @@ Start w [JOIN (CSepList bs.bs_autojoin) Nothing] shutdown = map toPrefix [QUIT $ Just "Bye"] - process :: String IRCMessage *File *World -> *(Maybe [IRCMessage], *File, *World) + process :: String !IRCMessage *File !*World -> (Maybe [IRCMessage], *File, !*World) process strf im io w # (io, w) = log strf " (r): " im (io, w) = case im.irc_command of @@ -182,9 +177,9 @@ Start w = (Just msgs, io, w) log :: String String IRCMessage (*File, *World) -> (*File, *World) - log strf pref m (io, w) - # (t, w) = localTime w - = (io <<< strfTime strf t <<< pref <<< toString m, w) + log strf pref m (io, w) = (io, w) +// # (t, w) = localTime w +// = (io <<< strfTime strf t <<< pref <<< toString m, w) process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World) process` (Just (Left user)) (PRIVMSG t m) w diff --git a/test.icl b/test.icl deleted file mode 100644 index 4347744..0000000 --- a/test.icl +++ /dev/null @@ -1,20 +0,0 @@ -module test - -import Gast -import IRC -import GenBimap -import Data.Func -import Data.Either - -import Text - -derive ggen IRCMessage, Either, IRCUser, IRCCommand, Maybe, CSepList, IRCNumReply, IRCReplies -derive genShow IRCMessage, Either, IRCUser, IRCCommand, Maybe, CSepList, IRCNumReply, IRCReplies - -//Doesn't work, generates illegal irc commands with spaces in recipients -Start = concat $ Test [] pParsePrint - -pParsePrint :: IRCMessage -> Bool -pParsePrint a -# str = toString a -= either (const False) ((==)str o toString) $ parseIRCMessage str -- 2.20.1