Commit e81450dc authored by Mart Lubbers's avatar Mart Lubbers

compiles, but doesn't work, probably strictness?

parent e0d24793
......@@ -2,3 +2,5 @@ test
Clean System Files
cloogleirc
IRC
IRCBot
cloogle
......@@ -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)
......@@ -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
......
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)
......
......@@ -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
......
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