Commit 73e3f056 authored by Mart Lubbers's avatar Mart Lubbers Committed by GitHub

Merge pull request #13 from clean-cloogle/pr-better-output

Pr better output
parents ad213068 ad6f64c9
......@@ -2,3 +2,5 @@ test
Clean System Files
cloogleirc
IRC
IRCBot
cloogle
......@@ -97,7 +97,7 @@ instance toInt IRCReplies, IRCErrors
RPL_ENDOFBANLIST | RPL_ENDOFWHOWAS | RPL_INFO | RPL_MOTD | RPL_ENDOFINFO |
RPL_MOTDSTART | RPL_ENDOFMOTD | RPL_YOUREOPER | RPL_REHASHING |
RPL_YOURESERVICE | RPL_TIME | RPL_USERSSTART | RPL_USERS | RPL_ENDOFUSERS |
RPL_NOUSERS
RPL_NOUSERS | RPL_UNKNOWN
:: IRCErrors = ERR_NOSUCHNICK | ERR_NOSUCHSERVER | ERR_NOSUCHCHANNEL |
ERR_CANNOTSENDTOCHAN | ERR_TOOMANYCHANNELS | ERR_WASNOSUCHNICK |
......@@ -115,4 +115,4 @@ instance toInt IRCReplies, IRCErrors
ERR_NOCHANMODES | ERR_BANLISTFULL | ERR_NOPRIVILEGES |
ERR_CHANOPRIVSNEEDED | ERR_CANTKILLSERVER | ERR_RESTRICTED |
ERR_UNIQOPPRIVSNEEDED | ERR_NOOPERHOST | ERR_UMODEUNKNOWNFLAG |
ERR_USERSDONTMATCH
ERR_USERSDONTMATCH | ERR_UNKNOWN
This diff is collapsed.
......@@ -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)
......@@ -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
= (Just $ "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
= (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 = (Error $ fromError merr, w)
| isError merr = (Just $ fromError merr, state, w)
//Start processing function
# (mer, chan, state, w) = process chan "" state bot w
| isError mer = (Error $ fromError mer, w)
| isError mer = (Just $ 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 = (Just $ fromError merr, state, w)
//Close channels
= (Ok state, closeChannel sChannel (closeRChannel rChannel w))
= (Nothing, 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)
......
CLEAN_HOME?=/opt/clean
CLM:=clm
override CLMFLAGS+=-nt -dynamics
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)
......
......@@ -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
......@@ -32,8 +33,7 @@ import TCPIP
import IRC
import IRCBot
TIMEOUT :== Just 10000
SERVER :== "irc.freenode.net"
import StdMisc, StdDebug
shorten :: String *World -> (String, *World)
shorten s w
......@@ -94,9 +94,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
......@@ -104,15 +102,19 @@ cloogle data w
, bs_autojoin :: [String]
, bs_port :: Int
, bs_server :: String
, bs_strftime :: String
}
Start :: *World -> (MaybeErrorString (), *World)
Start :: *World -> (Maybe String, *World)
Start w
# ([arg0:args], w) = getCommandLine w
# (io, w) = stdio w
# io = io <<< "\n"
# bs = parseCLI args
| isError bs = (Error $ "\n" +++ fromError bs +++ "\n", w)
//| isError bs = (Just $ "\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
= (Nothing, w)//= (merr, snd $ fclose io w)
where
parseCLI :: [String] -> MaybeErrorString BotSettings
parseCLI [] = Ok
......@@ -121,8 +123,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 +137,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,12 +167,22 @@ 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)
(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
......
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment