From 2b051d8c52d1d999a5ca902ef75f99635c80f540 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 18 Jul 2017 15:09:34 +0200 Subject: [PATCH] attempt better output, uniqueness error --- IRCBot.dcl | 4 ++-- IRCBot.icl | 23 ++++++++++++----------- cloogleirc.icl | 42 ++++++++++++++++++++++++++++++------------ 3 files changed, 44 insertions(+), 25 deletions(-) diff --git a/IRCBot.dcl b/IRCBot.dcl index 7ecf7ea..f0f0af2 100644 --- a/IRCBot.dcl +++ b/IRCBot.dcl @@ -22,6 +22,6 @@ from Data.Error import :: MaybeErrorString, :: MaybeError * If the response is nothing the connection is closed * All items in the list are sent back * param: World - * return: Maybe the state together with the new 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 -> (MaybeErrorString 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 0cd1022..2be18ad 100644 --- a/IRCBot.icl +++ b/IRCBot.icl @@ -14,29 +14,31 @@ import StdBool TIMEOUT :== Just 1000 -bot :: (String, Int) [IRCMessage] [IRCMessage] a (IRCMessage a *World -> (Maybe [IRCMessage], a, *World)) *World -> (MaybeErrorString 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 = (Error $ "DNS lookup for " +++ host +++ " failed", w) +| isNothing ip + = (Error $ "DNS lookup for " +++ host +++ " failed", state, w) //Connect # (rpt,chan,w) = connectTCP_MT TIMEOUT (fromJust ip, port) w -| rpt == TR_Expired = (Error $ "Connection to " +++ host +++ " timed out", w) -| rpt == TR_NoSuccess = (Error $ "Could not connect to " +++ host, w) +| rpt == TR_Expired + = (Error $ "Connection to " +++ host +++ " timed out", state, w) +| rpt == TR_NoSuccess + = (Error $ "Could not connect to " +++ host, state, w) // Send startup commands # (merr, chan, w) = send (map toString start) (fromJust chan) w -| isError merr = (Error $ fromError merr, w) +| isError merr = (Error $ fromError merr, state, w) //Start processing function # (mer, chan, state, w) = process chan "" state bot w -| isError mer = (Error $ fromError mer, w) +| isError mer = (Error $ fromError mer, state, w) // Send shutdown commands # (merr, {rChannel,sChannel}, w) = send (map toString end) chan w -| isError merr = (Error $ fromError merr, w) +| isError merr = (Error $ fromError merr, state, w) //Close channels -= (Ok state, closeChannel sChannel (closeRChannel rChannel w)) += (Ok state, state, closeChannel sChannel (closeRChannel rChannel w)) -import StdDebug,StdMisc -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 @@ -51,7 +53,6 @@ process chan acc state bot w //We have a successfull split and therefore we process at least one message [m:xs] # acc = join "\r\n" xs - | not (trace_tn $ "Full message: '" +++ m +++ "'") = undef = case parseIRCMessage $ m +++ "\r\n" of (Left err) = (Error $ "IRC Parsing error: " +++ join "\n" err, chan, state, w) (Right msg) diff --git a/cloogleirc.icl b/cloogleirc.icl index 5d05563..3aa328e 100644 --- a/cloogleirc.icl +++ b/cloogleirc.icl @@ -15,6 +15,7 @@ import Internet.HTTP import Text.JSON import Text.URI +import System.Time import Control.Applicative import qualified Control.Monad as CM @@ -104,15 +105,18 @@ cloogle data w , bs_autojoin :: [String] , bs_port :: Int , bs_server :: String + , bs_strftime :: String } -Start :: *World -> (MaybeErrorString (), *World) +//Start :: *World -> (MaybeErrorString (), *World) Start w # ([arg0:args], w) = getCommandLine w +# (io, w) = stdio w # bs = parseCLI args -| isError bs = (Error $ "\n" +++ fromError bs +++ "\n", w) +| isError bs = (Error $ "\n" +++ fromError bs +++ "\n", snd $ fclose io w) # (Ok bs) = bs -= bot (bs.bs_server, bs.bs_port) (startup bs) shutdown () process w +# (merr, io, w) = bot (bs.bs_server, bs.bs_port) (startup bs) shutdown io (process bs.bs_strftime) w += (maybe (Ok ()) Error merr, snd $ fclose io w) where parseCLI :: [String] -> MaybeErrorString BotSettings parseCLI [] = Ok @@ -121,8 +125,11 @@ Start w , bs_autojoin = [] , bs_port = 6667 , bs_server = "irc.freenode.net" + , bs_strftime = "%s" } parseCLI [a:as] + | a == "-f" || a == "--strftime" + = arg1 "--strftime" as \a c->{c & bs_strftime=a} | a == "-n" || a == "--nick" = arg1 "--nick" as \a c->{c & bs_nick=a} | a == "-ns" || a == "--nickserv" @@ -132,10 +139,11 @@ Start w | a == "-p" || a == "--port" = arg1 "--port" as \a c->{c & bs_port=toInt a} | a == "-s" || a == "--server" - = arg1 "--port" as \a c->{c & bs_server=a} + = arg1 "--server" as \a c->{c & bs_server=a} | a == "-h" || a == "--help" = Error $ join "\n" $ [ "Usage: cloogle [OPTS]" , "Options:" + , "\t--strftime/-f FORMAT strftime format used in the output. default: %s\n" , "\t--nick/-n NICKNAME Use the given nickname instead of clooglebot" , "\t--nickserv/-ns PW Identify via the given password with NickServ" , "\t--port/-p PORT Use the given port instead of port 6667" @@ -161,14 +169,24 @@ Start w [JOIN (CSepList bs.bs_autojoin) Nothing] shutdown = map toPrefix [QUIT $ Just "Bye"] - process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World) - process im s w = case im.irc_command of - Left numr = (Just [], (), w) + //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 + Left numr = (Just [], io, w) Right cmd = case process` im.irc_prefix cmd w of - (Nothing, w) = (Nothing, (), w) - (Just cs, w) = (Just $ map toPrefix cs, (), w) - - process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World) + (Nothing, w) = (Nothing, io, w) + (Just cs, w) + # msgs = map toPrefix cs + # (io, w) = foldr (log strf " (s): ") (io, w) msgs + = (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) + + //process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World) process` (Just (Left user)) (PRIVMSG t m) w | m == "!restart" = (Nothing, w) | m.[0] == '!' @@ -182,7 +200,7 @@ Start w process` _ (PING t mt) w = (Just [PONG t mt], w) process` _ _ w = (Just [], w) - realProcess :: [String] *World -> ([String], *World) + //realProcess :: [String] *World -> ([String], *World) realProcess ["help",x:xs] w = ((case x of "help" = [ "Usage: !help [ARG]" -- 2.20.1