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
33 commands = map toString
34 [NICK "clooglebot" Nothing
35 ,USER "cloogle" "0" "cloogle" "Cloogle bot"
36 ,JOIN (CSepList ["#cloogle"]) Nothing
39 TIMEOUT :== Just 10000
40 SERVER :== "irc.freenode.net"
42 KEY :== "PRIVMSG #cloogle :!"
44 doRequest :: HTTPRequest *World -> *(MaybeErrorString HTTPResponse, *World)
46 # (ip,w) = lookupIPAddress server_name w
48 = (Error $ "DNS lookup for " + server_name + " failed.", w)
50 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, req.server_port) w
52 = (Error $ "Connection to " + toString ip + " timed out.", w)
54 = (Error $ "Could not connect to " + server_name + ".", w)
55 # (Just {sChannel,rChannel}) = chan
56 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq req) sChannel w
58 = (Error $ "Could not send request to " + server_name + ".", w)
59 # (rpt,resp,rChannel,w) = receive_MT TIMEOUT rChannel w
61 = (Error $ "Did not receive a reply from " + server_name + ".", w)
62 # resp = 'CM'.join $ parseResponse <$> toString <$> resp
64 # w = closeChannel sChannel (closeRChannel rChannel w)
65 = (Error $ "Server did not respond with HTTP.", w)
66 # (resp,rChannel,w) = receiveRest (fromJust resp) rChannel w
67 # w = closeChannel sChannel (closeRChannel rChannel w)
70 server_name = req.server_name
71 receiveRest resp chan w
72 # cl = lookup "Content-Length" resp.HTTPResponse.rsp_headers
75 | size resp.rsp_data >= toInt (fromJust cl)
77 # (rpt,newresp,chan,w) = receive_MT TIMEOUT chan w
79 = (Error $ server_name + " hung up during transmission.", chan, w)
80 = receiveRest {resp & rsp_data=resp.rsp_data + toString (fromJust newresp)} chan w
85 doRequestL :: HTTPRequest Int *World -> *(MaybeErrorString HTTPResponse, *World)
86 doRequestL req 0 w = (Error "Maximal redirect numbe exceeded", w)
87 doRequestL req maxRedirects w
88 | not (trace_tn $ toString req) = undef
89 # (er, w) = doRequest req w
90 | isError er = (er, w)
92 | isMember resp.HTTPResponse.rsp_code [301, 302, 303, 307, 308]
93 = case lookup "Location" resp.HTTPResponse.rsp_headers of
94 Nothing = (Error $ "Redirect given but no Location header", w)
95 Just loc = case parseURI loc of
96 Nothing = (Error $ "Redirect URI couldn't be parsed", w)
97 Just uri = doRequestL {req
98 & server_name = maybe loc id uri.uriRegName
99 , server_port = maybe 80 id uri.uriPort
100 , req_path = uri.uriPath
101 , req_query = maybe "" ((+++) "?") uri.uriQuery
105 shorten :: String *World -> (String, *World)
107 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
108 # data = "type=regular&url="+urlEncode s+"&token=a"
109 # (mer, w) = doRequest
111 & req_method = HTTP_POST
113 , server_name = "cloo.gl"
115 , req_headers = 'DM'.fromList
116 [("Content-Type", "application/x-www-form-urlencoded")
117 ,("Content-Length", toString $ size data)
120 | isError mer = ("request failed: " + fromError mer, w)
124 cloogle :: String *World -> (String, *World)
126 # (mer, w) = doRequestL
128 & req_path = "/api.php"
129 , req_query = "?str=" + urlEncode data
130 , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
131 , server_name = "cloogle.org"
132 , server_port = 80} 10 w
133 | isError mer = ("request failed: " + fromError mer, w)
135 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
136 Nothing = ("couldn't parse json", w)
137 Just clr = ("Results for " + data + " -- https://cloogle.org/#" + replaceSubString "+" "%20" (urlEncode data) + "\n" +
138 processResults clr, w)
140 processResults :: Response -> String
142 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
143 = join "\n" $ map processResult $ take 3 resp.data
145 processResult :: Result -> String
146 processResult (FunctionResult (br, {func}))
147 = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
148 processResult (TypeResult (br, {type}))
149 = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
150 processResult (ClassResult (br, {class_name,class_funs}))
151 = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
152 +++ toString (length class_funs) +++ " class functions"
153 //processResult (MacroResult (br, {macro_name}))
154 // = "Macro in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ macro_name
155 processResult (ModuleResult (br, _))
156 = "Module in " +++ br.library +++ ": " +++ br.modul
158 limitResults :: String -> String
160 # lines = split "\n" s
161 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
162 = join "\n" (map maxWidth lines)
164 maxWidth :: String -> String
166 | size s > 80 = subString 0 77 s + "..."
170 ["stop":_] = (w, Nothing)
171 ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs])
173 # (s, w) = cloogle (join " " xs) w
174 = (w, Just $ map msg $ split "\n" s)
175 ["short"] = (w, Just [msg $ "short requires an url argument"])
177 # (s, w) = shorten (join " " xs) w
180 [msg "type !help cmd for command specific help"
181 ,msg "available commands: help, ping, query, short"])
182 ["help":c:_] = (w, case c of
183 "help" = Just [msg "help [CMD] - I will print general help or the help of CMD"]
184 "ping" = Just [msg "ping [TXT] - I will reply with pong and the optionar TXT"]
185 "query" = Just [msg "query QUERY - I will send QUERY to cloogle and post the results"]
186 "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"]
187 _ = Just [msg "Unknown command"])
188 [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]])
191 Start :: *World -> (MaybeErrorString (), *World)
192 Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w
194 toPrefix c = {irc_prefix=Nothing,irc_command=Right c}
195 startup = map toPrefix
196 [NICK "clooglebot" Nothing
197 ,USER "cloogle" "cloogle" "cloogle" "Cloogle bot"
198 ,JOIN (CSepList ["#cloogle"]) Nothing]
199 shutdown = map toPrefix [QUIT $ Just "Bye"]
201 process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World)
202 process im s w = case im.irc_command of
203 Left numr = (Just [], (), w)
204 Right cmd = case process` cmd w of
205 (Nothing, w) = (Nothing, (), w)
206 (Just cs, w) = (Just $ map toPrefix cs, (), w)
208 process` :: IRCCommand *World -> (Maybe [IRCCommand], *World)
209 process` (PRIVMSG t m) w = (Just $ if (startsWith "!" m)
210 (map (PRIVMSG t) $ realProcess $ split " " $ subString 1 (size m) m)
212 process` (PING t mt) w = (Just [PONG t mt], w)
213 process` _ w = (Just [], w)
215 realProcess :: [String] -> [String]
216 realProcess ["help":xs] =
217 ["type !help cmd for command specific help"
218 ,"available commands: help"]
219 realProcess [c:_] = [join " " ["unknown cmd: ", c, ", type !help to get help"]]