From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 24 Jul 2017 12:13:09 +0000 (+0200)
Subject: compiles, but doesn't work, probably strictness?
X-Git-Url: https://git.martlubbers.net/?p=cloogle-irc.git;a=commitdiff_plain;h=e81450dc6e427524ac74160cc9d54b1d8fb40cba

compiles, but doesn't work, probably strictness?
---

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