11 from Data.Func import $
12 from Text import class Text(..), instance Text String, instance + String
18 import Control.Applicative
19 import qualified Control.Monad as CM
20 import qualified Data.Map as DM
21 from Control.Monad import class Monad, instance Monad Maybe
22 from Text.Encodings.UrlEncoding import urlEncode
32 commands = map toString
33 [NICK "clooglebot" Nothing
34 ,USER "cloogle" "0" "Cloogle bot"
35 ,JOIN [("#cloogle", Nothing)]
38 TIMEOUT :== Just 10000
39 SERVER :== "irc.freenode.net"
41 KEY :== "PRIVMSG #cloogle :!"
43 doRequest :: HTTPRequest *World -> *(MaybeErrorString HTTPResponse, *World)
45 # (ip,w) = lookupIPAddress server_name w
47 = (Error $ "DNS lookup for " + server_name + " failed.", w)
49 # (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, req.server_port) w
51 = (Error $ "Connection to " + toString ip + " timed out.", w)
53 = (Error $ "Could not connect to " + server_name + ".", w)
54 # (Just {sChannel,rChannel}) = chan
55 # (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq req) sChannel w
57 = (Error $ "Could not send request to " + server_name + ".", w)
58 # (rpt,resp,rChannel,w) = receive_MT TIMEOUT rChannel w
60 = (Error $ "Did not receive a reply from " + server_name + ".", w)
61 # resp = 'CM'.join $ parseResponse <$> toString <$> resp
63 # w = closeChannel sChannel (closeRChannel rChannel w)
64 = (Error $ "Server did not respond with HTTP.", w)
65 # (resp,rChannel,w) = receiveRest (fromJust resp) rChannel w
66 # w = closeChannel sChannel (closeRChannel rChannel w)
69 server_name = req.server_name
70 receiveRest resp chan w
71 # cl = lookup "Content-Length" resp.HTTPResponse.rsp_headers
74 | size resp.rsp_data >= toInt (fromJust cl)
76 # (rpt,newresp,chan,w) = receive_MT TIMEOUT chan w
78 = (Error $ server_name + " hung up during transmission.", chan, w)
79 = receiveRest {resp & rsp_data=resp.rsp_data + toString (fromJust newresp)} chan w
84 doRequestL :: HTTPRequest Int *World -> *(MaybeErrorString HTTPResponse, *World)
85 doRequestL req 0 w = (Error "Maximal redirect numbe exceeded", w)
86 doRequestL req maxRedirects w
87 | not (trace_tn $ toString req) = undef
88 # (er, w) = doRequest req w
89 | isError er = (er, w)
91 | isMember resp.HTTPResponse.rsp_code [301, 302, 303, 307, 308]
92 = case lookup "Location" resp.HTTPResponse.rsp_headers of
93 Nothing = (Error $ "Redirect given but no Location header", w)
94 Just loc = case parseURI loc of
95 Nothing = (Error $ "Redirect URI couldn't be parsed", w)
96 Just uri = doRequestL {req
97 & server_name = maybe loc id uri.uriRegName
98 , server_port = maybe 80 id uri.uriPort
99 , req_path = uri.uriPath
100 , req_query = maybe "" ((+++) "?") uri.uriQuery
104 shorten :: String *World -> (String, *World)
106 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
107 # data = "type=regular&url="+urlEncode s+"&token=a"
108 # (mer, w) = doRequest
110 & req_method = HTTP_POST
112 , server_name = "cloo.gl"
114 , req_headers = 'DM'.fromList
115 [("Content-Type", "application/x-www-form-urlencoded")
116 ,("Content-Length", toString $ size data)
119 | isError mer = ("request failed: " + fromError mer, w)
123 cloogle :: String *World -> (String, *World)
125 # (mer, w) = doRequestL
127 & req_path = "/api.php"
128 , req_query = "?str=" + urlEncode data
129 , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
130 , server_name = "cloogle.org"
131 , server_port = 80} 10 w
132 | isError mer = ("request failed: " + fromError mer, w)
134 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
135 Nothing = ("couldn't parse json", w)
136 Just clr = ("Results for " + data + " -- https://cloogle.org/#" + replaceSubString "+" "%20" (urlEncode data) + "\n" +
137 processResults clr, w)
139 processResults :: Response -> String
141 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
142 = join "\n" $ map processResult $ take 3 resp.data
144 processResult :: Result -> String
145 processResult (FunctionResult (br, {func}))
146 = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
147 processResult (TypeResult (br, {type}))
148 = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
149 processResult (ClassResult (br, {class_name,class_funs}))
150 = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
151 +++ toString (length class_funs) +++ " class functions"
152 processResult (MacroResult (br, {macro_name}))
153 = "Macro in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ macro_name
154 processResult (ModuleResult (br, _))
155 = "Module in " +++ br.library +++ ": " +++ br.modul
157 limitResults :: String -> String
159 # lines = split "\n" s
160 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
161 = join "\n" (map maxWidth lines)
163 maxWidth :: String -> String
165 | size s > 80 = subString 0 77 s + "..."
169 ["stop":_] = (w, Nothing)
170 ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs])
172 # (s, w) = cloogle (join " " xs) w
173 = (w, Just $ map msg $ split "\n" s)
174 ["short"] = (w, Just [msg $ "short requires an url argument"])
176 # (s, w) = shorten (join " " xs) w
179 [msg "type !help cmd for command specific help"
180 ,msg "available commands: help, ping, query, short"])
181 ["help":c:_] = (w, case c of
182 "help" = Just [msg "help [CMD] - I will print general help or the help of CMD"]
183 "ping" = Just [msg "ping [TXT] - I will reply with pong and the optionar TXT"]
184 "query" = Just [msg "query QUERY - I will send QUERY to cloogle and post the results"]
185 "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"]
186 _ = Just [msg "Unknown command"])
187 [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]])
190 Start :: *World -> (MaybeErrorString (), *World)
191 Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w
193 toPrefix c = {irc_prefix=Nothing,irc_command=Right c}
194 startup = map toPrefix
195 [NICK "clooglebot" Nothing
196 ,USER "cloogle" "0" "Cloogle bot"
197 ,JOIN [("#cloogle", Nothing)]]
198 shutdown = map toPrefix [QUIT (Just "Bye")]
200 process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World)
201 process im s w = case im.irc_command of
202 Left numr = (Just [], (), w)
203 Right cmd = case process` cmd w of
204 (Nothing, w) = (Nothing, (), w)
205 (Just cs, w) = (Just $ map toPrefix cs, (), w)
207 process` :: IRCCommand *World -> (Maybe [IRCCommand], *World)
208 process` (PRIVMSG t m) w = (Just $ if (startsWith "!" m)
209 (map (PRIVMSG t) $ realProcess $ split " " $ subString 1 (size m) m)
211 process` (PING t mt) w = (Just [PONG t mt], w)
212 process` _ w = (Just [], w)
214 realProcess :: [String] -> [String]
215 realProcess ["help":xs] =
216 ["type !help cmd for command specific help"
217 ,"available commands: help"]
218 realProcess [c:_] = [join " " ["unknown cmd: ", c, ", type !help to get help"]]