fix printing of numeric reply

diff --git a/IRC.icl b/IRC.icl
index 0fb408f..f51bc8a 100644 (file)
--- a/IRC.icl
+++ b/IRC.icl
@@ -125,7 +125,7 @@ illegal = ['\x00','\r','\n']
 
 instance toString IRCNumReply where
        toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+
 
 instance toString IRCNumReply where
        toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+

-               m.irc_recipient <+ concat (gIRCPrint{|*|} m.irc_message)
+               m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message)

 instance toString IRCMessage where
        toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
                <+ either toString toString m.irc_command
 instance toString IRCMessage where
        toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
                <+ either toString toString m.irc_command

diff --git a/Makefile b/Makefile
index 0bbd16a..570ed8d 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -13,9 +13,10 @@ CLMLIBS:=\
        -I $(CLEAN_HOME)/lib/Generics\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I $(CLEAN_HOME)/lib/Dynamics\
        -I $(CLEAN_HOME)/lib/Generics\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I $(CLEAN_HOME)/lib/Dynamics\

+       -I ~/projects/gast/Libraries\

        -I ./libcloogle
 
        -I ./libcloogle
 

-BINARIES:=IRC cloogle
+BINARIES:=IRC cloogle test

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

diff --git a/cloogle.icl b/cloogle.icl
index 182c213..35b71c2 100644 (file)
--- a/cloogle.icl
+++ b/cloogle.icl
@@ -10,6 +10,8 @@ import Data.Either
 from Data.Func import $, mapSt
 from Text import class Text(..), instance Text String, instance + String
 
 from Data.Func import $, mapSt
 from Text import class Text(..), instance Text String, instance + String
 

+import Internet.HTTP
+

 import Text.JSON
 
 import Text.URI
 import Text.JSON
 
 import Text.URI


@@ -32,72 +34,11 @@ import IRCBot
 TIMEOUT :== Just 10000
 SERVER :== "irc.freenode.net"
 
 TIMEOUT :== Just 10000
 SERVER :== "irc.freenode.net"
 

-doRequest :: HTTPRequest *World -> *(MaybeErrorString HTTPResponse, *World)
-doRequest req w
-# (ip,w) = lookupIPAddress server_name w
-| isNothing ip
-       = (Error $ "DNS lookup for " + server_name + " failed.", w)
-# (Just ip) = ip
-# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, req.server_port) w
-| rpt == TR_Expired
-       = (Error $ "Connection to " + toString ip + " timed out.", w)
-| rpt == TR_NoSuccess
-       = (Error $ "Could not connect to " + server_name + ".", w)
-# (Just {sChannel,rChannel}) = chan
-# (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq req) sChannel w
-| rpt <> TR_Success
-       = (Error $ "Could not send request to " + server_name + ".", w)
-# (rpt,resp,rChannel,w) = receive_MT TIMEOUT rChannel w
-| rpt <> TR_Success
-       = (Error $ "Did not receive a reply from " + server_name + ".", w)
-# resp = 'CM'.join $ parseResponse <$> toString <$> resp
-| isNothing resp
-       # w = closeChannel sChannel (closeRChannel rChannel w)
-       = (Error $ "Server did not respond with HTTP.", w)
-# (resp,rChannel,w) = receiveRest (fromJust resp) rChannel w
-# w = closeChannel sChannel (closeRChannel rChannel w)
-= (resp,w)
-where
-       server_name = req.server_name
-       receiveRest resp chan w
-       # cl = lookup "Content-Length" resp.HTTPResponse.rsp_headers
-       | isNothing cl
-               = (Ok resp, chan, w)
-       | size resp.rsp_data >= toInt (fromJust cl)
-               = (Ok resp, chan, w)
-       # (rpt,newresp,chan,w) = receive_MT TIMEOUT chan w
-       | rpt <> TR_Success
-               = (Error $ server_name + " hung up during transmission.", chan, w)
-       = receiveRest {resp & rsp_data=resp.rsp_data + toString (fromJust newresp)} chan w
-
-import StdMisc
-import StdDebug
-
-doRequestL :: HTTPRequest Int *World -> *(MaybeErrorString HTTPResponse, *World)
-doRequestL req 0 w = (Error "Maximal redirect number exceeded", w)
-doRequestL req maxRedirects w
-| not (trace_tn $ toString req) = undef
-# (er, w) = doRequest req w
-| isError er = (er, w)
-# resp = fromOk er
-| isMember resp.HTTPResponse.rsp_code [301, 302, 303, 307, 308]
-       = case lookup "Location" resp.HTTPResponse.rsp_headers of
-               Nothing = (Error $ "Redirect given but no Location header", w)
-               Just loc = case parseURI loc of
-                       Nothing = (Error $ "Redirect URI couldn't be parsed", w)
-                       Just uri = doRequestL {req 
-                               & server_name = maybe loc id uri.uriRegName
-                               , server_port = maybe 80 id uri.uriPort
-                               , req_path = uri.uriPath
-                               , req_query = maybe "" ((+++) "?") uri.uriQuery
-                               } (maxRedirects-1) w
-= (er, w)
-

 shorten :: String *World -> (String, *World)
 shorten s w 
 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
 # data = "type=regular&url="+urlEncode s+"&token=a"
 shorten :: String *World -> (String, *World)
 shorten s w 
 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
 # data = "type=regular&url="+urlEncode s+"&token=a"

-# (mer, w) = doRequest 
+# (mer, w) = doHTTPRequest 

                { newHTTPRequest
                & req_method = HTTP_POST
                , req_path = "/"
                { newHTTPRequest
                & req_method = HTTP_POST
                , req_path = "/"


@@ -107,20 +48,20 @@ shorten s w
                        [("Content-Type", "application/x-www-form-urlencoded")
                        ,("Content-Length", toString $ size data)
                        ,("Accept", "*/*")]
                        [("Content-Type", "application/x-www-form-urlencoded")
                        ,("Content-Length", toString $ size data)
                        ,("Accept", "*/*")]

-               , req_data = data} w
+               , req_data = data} 10000 w

 | isError mer = ("request failed: " + fromError mer, w)
 # resp = fromOk mer
 = (resp.rsp_data, w)
 
 cloogle :: String *World -> (String, *World)
 cloogle data w
 | isError mer = ("request failed: " + fromError mer, w)
 # resp = fromOk mer
 = (resp.rsp_data, w)
 
 cloogle :: String *World -> (String, *World)
 cloogle data w

-# (mer, w) = doRequestL
+# (mer, w) = doHTTPRequestL

                { newHTTPRequest
                & req_path = "/api.php"
                , req_query = "?str=" + urlEncode data
                , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
                , server_name = "cloogle.org"
                { newHTTPRequest
                & req_path = "/api.php"
                , req_query = "?str=" + urlEncode data
                , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
                , server_name = "cloogle.org"

-               , server_port = 80} 10 w
+               , server_port = 80} 10000 10 w

 | isError mer = ("request failed: " + fromError mer, w)
 # resp = fromOk mer
 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
 | isError mer = ("request failed: " + fromError mer, w)
 # resp = fromOk mer
 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of

diff --git a/test.icl b/test.icl
index f402f99..4347744 100644 (file)
--- a/test.icl
+++ b/test.icl
@@ -1,12 +1,20 @@
 module test
 
 module test
 

-
-import gast
+import Gast

 import IRC
 import IRC

+import GenBimap
+import Data.Func
+import Data.Either
+
+import Text

 
 

-derive ggen IRCMessage
+derive ggen IRCMessage, Either, IRCUser, IRCCommand, Maybe, CSepList, IRCNumReply, IRCReplies
+derive genShow IRCMessage, Either, IRCUser, IRCCommand, Maybe, CSepList, IRCNumReply, IRCReplies

 
 

-Start = Test [] pParsePrint
+//Doesn't work, generates illegal irc commands with spaces in recipients
+Start = concat $ Test [] pParsePrint

 
 pParsePrint :: IRCMessage -> Bool
 
 pParsePrint :: IRCMessage -> Bool

-pParsePrint a = toString (parseIRCMessage (toString a)) == toString a
+pParsePrint a
+# str = toString a
+= either (const False) ((==)str o toString) $ parseIRCMessage str