From 1547e1cacf063d05c1ae686e6a1047792e13ef60 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 13 Jul 2017 07:56:12 +0200 Subject: [PATCH] fix printing of numeric reply --- IRC.icl | 2 +- Makefile | 3 ++- cloogle.icl | 71 +++++------------------------------------------------ test.icl | 18 ++++++++++---- 4 files changed, 22 insertions(+), 72 deletions(-) diff --git a/IRC.icl b/IRC.icl index 0fb408f..f51bc8a 100644 --- 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' <+ " " <+ - 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 diff --git a/Makefile b/Makefile index 0bbd16a..570ed8d 100644 --- 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 ~/projects/gast/Libraries\ -I ./libcloogle -BINARIES:=IRC cloogle +BINARIES:=IRC cloogle test all: $(BINARIES) diff --git a/cloogle.icl b/cloogle.icl index 182c213..35b71c2 100644 --- 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 +import Internet.HTTP + import Text.JSON import Text.URI @@ -32,72 +34,11 @@ import IRCBot 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" -# (mer, w) = doRequest +# (mer, w) = doHTTPRequest { 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", "*/*")] - , 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 -# (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" - , 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 diff --git a/test.icl b/test.icl index f402f99..4347744 100644 --- a/test.icl +++ b/test.icl @@ -1,12 +1,20 @@ module test - -import gast +import Gast 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 a = toString (parseIRCMessage (toString a)) == toString a +pParsePrint a +# str = toString a += either (const False) ((==)str o toString) $ parseIRCMessage str -- 2.20.1