compiles, but doesn't work, probably strictness?

diff --git a/.gitignore b/.gitignore
index 29de276..b7a24d7 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,5 @@ test
 Clean System Files
 cloogleirc
 IRC
 Clean System Files
 cloogleirc
 IRC

+IRCBot
+cloogle

diff --git a/IRCBot.dcl b/IRCBot.dcl
index f0f0af2..06d8e7f 100644 (file)
--- 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
 */
  * 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 (file)
--- a/IRCBot.icl
+++ b/IRCBot.icl
@@ -14,31 +14,31 @@ import StdBool
 
 TIMEOUT :== Just 1000
 
 
 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
 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
 //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
 | 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
 // 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
 //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
 // 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
 //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
 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
        [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
                # (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)
        //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
                        //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
 
                        //Recurse
                        = process chan acc state bot w
 

diff --git a/Makefile b/Makefile
index 3e08ebb..80b0c7e 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
 CLEAN_HOME?=/opt/clean
 CLM:=clm
 
 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
 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
 
        -I $(CLEAN_HOME)/lib/Dynamics\
        -I ./libcloogle
 

-BINARIES:=IRC cloogleirc #test
+BINARIES:=IRC IRCBot cloogleirc #test

 
 all: $(BINARIES)
 
 
 all: $(BINARIES)
 

diff --git a/cloogleirc.icl b/cloogleirc.icl
index a83663b..46c20f1 100644 (file)
--- a/cloogleirc.icl
+++ b/cloogleirc.icl
@@ -33,9 +33,6 @@ import TCPIP
 import IRC
 import IRCBot
 
 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))
 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
                = 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
 
 :: BotSettings =
                { bs_nick     :: String


@@ -113,10 +108,10 @@ Start w
 # ([arg0:args], w) = getCommandLine w
 # (io, w) = stdio w
 # bs = parseCLI args 
 # ([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
 # (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
        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"]
 
                                [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
                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)
                                = (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
 
                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 (file)
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