10 from Data.Func import $
11 from Text import class Text(..), instance Text String, instance + String
17 import Control.Applicative
18 import qualified Control.Monad as CM
19 import qualified Data.Map as DM
20 from Control.Monad import class Monad, instance Monad Maybe
21 from Text.Encodings.UrlEncoding import urlEncode
31 commands = map toString
33 ,USER "cloogle" 0 "Cloogle bot"
34 ,JOIN [("#cloogle", Nothing)]
37 TIMEOUT :== Just 10000
38 SERVER :== "irc.freenode.net"
40 KEY :== "PRIVMSG #cloogle :!"
42 doRequest :: HTTPRequest *World -> *(MaybeErrorString HTTPResponse, *World)
44 # (ip,w) = lookupIPAddress server_name w
46 = (Error $ "DNS lookup for " + server_name + " failed.", w)
48 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, req.server_port) w
50 = (Error $ "Connection to " + toString ip + " timed out.", w)
52 = (Error $ "Could not connect to " + server_name + ".", w)
53 # (Just {sChannel,rChannel}) = chan
54 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq req) sChannel w
56 = (Error $ "Could not send request to " + server_name + ".", w)
57 # (rpt,resp,rChannel,w) = receive_MT TIMEOUT rChannel w
59 = (Error $ "Did not receive a reply from " + server_name + ".", w)
60 # resp = 'CM'.join $ parseResponse <$> toString <$> resp
62 # w = closeChannel sChannel (closeRChannel rChannel w)
63 = (Error $ "Server did not respond with HTTP.", w)
64 # (resp,rChannel,w) = receiveRest (fromJust resp) rChannel w
65 # w = closeChannel sChannel (closeRChannel rChannel w)
68 server_name = req.server_name
69 receiveRest resp chan w
70 # cl = lookup "Content-Length" resp.HTTPResponse.rsp_headers
73 | size resp.rsp_data >= toInt (fromJust cl)
75 # (rpt,newresp,chan,w) = receive_MT TIMEOUT chan w
77 = (Error $ server_name + " hung up during transmission.", chan, w)
78 = receiveRest {resp & rsp_data=resp.rsp_data + toString (fromJust newresp)} chan w
83 doRequestL :: HTTPRequest Int *World -> *(MaybeErrorString HTTPResponse, *World)
84 doRequestL req 0 w = (Error "Maximal redirect numbe exceeded", w)
85 doRequestL req maxRedirects w
86 | not (trace_tn $ toString req) = undef
87 # (er, w) = doRequest req w
88 | isError er = (er, w)
90 | isMember resp.HTTPResponse.rsp_code [301, 302, 303, 307, 308]
91 = case lookup "Location" resp.HTTPResponse.rsp_headers of
92 Nothing = (Error $ "Redirect given but no Location header", w)
93 Just loc = case parseURI loc of
94 Nothing = (Error $ "Redirect URI couldn't be parsed", w)
95 Just uri = doRequestL {req
96 & server_name = maybe loc id uri.uriRegName
97 , server_port = maybe 80 id uri.uriPort
98 , req_path = uri.uriPath
99 , req_query = maybe "" ((+++) "?") uri.uriQuery
103 shorten :: String *World -> (String, *World)
105 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
106 # data = "type=regular&url="+urlEncode s+"&token=a"
107 # (mer, w) = doRequest
109 & req_method = HTTP_POST
111 , server_name = "cloo.gl"
113 , req_headers = 'DM'.fromList
114 [("Content-Type", "application/x-www-form-urlencoded")
115 ,("Content-Length", toString $ size data)
118 | isError mer = ("request failed: " + fromError mer, w)
122 cloogle :: String *World -> (String, *World)
124 # (mer, w) = doRequestL
126 & req_path = "/api.php"
127 , req_query = "?str=" + urlEncode data
128 , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
129 , server_name = "cloogle.org"
130 , server_port = 80} 10 w
131 | isError mer = ("request failed: " + fromError mer, w)
133 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
134 Nothing = ("couldn't parse json", w)
135 Just clr = ("Results for " + data + " -- https://cloogle.org/#" + urlEncode data + "\n" +
136 processResults clr, w)
138 processResults :: Response -> String
140 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
141 = join "\n" $ map processResult $ take 3 resp.data
143 processResult :: Result -> String
144 processResult (FunctionResult (br, {func}))
145 = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
146 processResult (TypeResult (br, {type}))
147 = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
148 processResult (ClassResult (br, {class_name,class_funs}))
149 = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
150 +++ toString (length class_funs) +++ " class functions"
151 processResult (MacroResult (br, {macro_name}))
152 = "Macro in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ macro_name
153 processResult (ModuleResult (br, _))
154 = "Module in " +++ br.library +++ ": " +++ br.modul
156 limitResults :: String -> String
158 # lines = split "\n" s
159 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
160 = join "\n" (map maxWidth lines)
162 maxWidth :: String -> String
164 | size s > 80 = subString 0 77 s + "..."
167 send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
168 send [] chan w = (chan, w)
169 send [msg:msgs] {sChannel,rChannel} w
170 # (_, w) = sleep 250000 w
171 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
172 | rpt <> TR_Success = abort "Could not send request\n"
173 = send msgs {sChannel=sChannel,rChannel=rChannel} w
175 sleep :: !Int !*World -> (!Int, *World)
180 recv :: TCP_DuplexChannel *World -> (Maybe String, TCP_DuplexChannel, *World)
181 recv {sChannel,rChannel} w
182 # (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
183 | rpt == TR_Expired = (Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
184 | rpt == TR_NoSuccess || isNothing resp = abort "Halp?\n"
185 = (toString <$> resp, {sChannel=sChannel,rChannel=rChannel}, w)
187 msg :: (String -> IRCCommand)
188 msg = PRIVMSG "#cloogle"
190 process :: *File TCP_DuplexChannel *World -> (*File, TCP_DuplexChannel, *World)
192 # (mr, chan, w) = recv chan w
193 | isNothing mr = process io chan w
195 #! io = io <<< ("Received: " +++ resp +++ "\n")
196 # ind = indexOf KEY resp
198 # cmd = split " " $ rtrim $ subString (ind + size KEY) (size resp) resp
199 #! io = io <<< ("Received command: " +++ printToString cmd +++ "\n")
200 # (w, toSend) = case cmd of
201 ["stop":_] = (w, Nothing)
202 ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs])
204 # (s, w) = cloogle (join " " xs) w
205 = (w, Just $ map msg $ split "\n" s)
206 ["short"] = (w, Just [msg $ "short requires an url argument"])
208 # (s, w) = shorten (join " " xs) w
211 [msg "type !help cmd for command specific help"
212 ,msg "available commands: help, ping, query, short"])
213 ["help":c:_] = (w, case c of
214 "help" = Just [msg "help [CMD] - I will print general help or the help of CMD"]
215 "ping" = Just [msg "ping [TXT] - I will reply with pong and the optionar TXT"]
216 "query" = Just [msg "query QUERY - I will send QUERY to cloogle and post the results"]
217 "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"]
218 _ = Just [msg "Unknown command"])
219 [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]])
220 | isNothing toSend = (io, chan, w)
221 # (chan, w) = send (map toString $ fromJust toSend) chan w
223 | indexOf "PING :" resp >= 0
224 # cmd = rtrim $ subString (indexOf "PING :" resp + size "PING :") (size resp) resp
225 #! io = io <<< (toString $ PONG cmd Nothing) <<< "\n"
226 # (chan, w) = send [toString $ PONG cmd Nothing] chan w
230 Start :: *World -> *World
233 # (ip, w) = lookupIPAddress SERVER w
234 | isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
236 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
237 | rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
238 | rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
239 # chan = fromJust chan
240 # (chan, w) = send commands chan w
241 # (io, chan, w) = process io chan w
242 # ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
243 # (_, w) = fclose io w
244 = closeChannel sChannel (closeRChannel rChannel w)