10 from Data.Func import $, mapSt
11 from Text import class Text(..), instance Text String, instance + String
19 import Control.Applicative
20 import qualified Control.Monad as CM
21 import qualified Data.Map as DM
22 from Control.Monad import class Monad, instance Monad Maybe
23 from Text.Encodings.UrlEncoding import urlEncode
34 TIMEOUT :== Just 10000
35 SERVER :== "irc.freenode.net"
37 shorten :: String *World -> (String, *World)
39 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
40 # data = "type=regular&url="+urlEncode s+"&token=a"
41 # (mer, w) = doHTTPRequest
43 & req_method = HTTP_POST
45 , server_name = "cloo.gl"
47 , req_headers = 'DM'.fromList
48 [("Content-Type", "application/x-www-form-urlencoded")
49 ,("Content-Length", toString $ size data)
51 , req_data = data} 10000 w
52 | isError mer = ("request failed: " + fromError mer, w)
56 cloogle :: String *World -> (String, *World)
58 # (mer, w) = doHTTPRequestL
60 & req_path = "/api.php"
61 , req_query = "?str=" + urlEncode data
62 , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
63 , server_name = "cloogle.org"
64 , server_port = 80} 10000 10 w
65 | isError mer = ("request failed: " + fromError mer, w)
67 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
68 Nothing = ("couldn't parse json", w)
69 Just clr = ("Results for " + data + " -- https://cloogle.org/#" +
70 replaceSubString "+" "%20" (urlEncode data) + "\n" +
71 processResults clr, w)
73 processResults :: Response -> String
75 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
76 = join "\n" $ map processResult $ take 3 resp.data
78 processResult :: Result -> String
79 processResult (FunctionResult (br, {func}))
80 = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
81 processResult (TypeResult (br, {type}))
82 = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
83 processResult (ClassResult (br, {class_name,class_funs}))
84 = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
85 +++ toString (length class_funs) +++ " class functions"
86 processResult (ModuleResult (br, _))
87 = "Module in " +++ br.library +++ ": " +++ br.modul
89 limitResults :: String -> String
91 # lines = split "\n" s
92 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
93 = join "\n" (map maxWidth lines)
95 maxWidth :: String -> String
97 | size s > 80 = subString 0 77 s + "..."
101 Start :: *World -> (MaybeErrorString (), *World)
102 Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w
104 toPrefix c = {irc_prefix=Nothing,irc_command=Right c}
105 startup = map toPrefix
106 [NICK "clooglebot" Nothing
107 ,USER "cloogle" "cloogle" "cloogle" "Cloogle bot"
108 ,JOIN (CSepList ["#cloogle", "#cleanlang"]) Nothing]
109 shutdown = map toPrefix [QUIT $ Just "Bye"]
111 process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World)
112 process im s w = case im.irc_command of
113 Left numr = (Just [], (), w)
114 Right cmd = case process` im.irc_prefix cmd w of
115 (Nothing, w) = (Nothing, (), w)
116 (Just cs, w) = (Just $ map toPrefix cs, (), w)
118 process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World)
119 process` (Just (Left user)) (PRIVMSG t m) w
120 | m == "!restart" = (Nothing, w)
122 # (msgs, w) = realProcess (split " " $ m % (1, size m)) w
123 = (Just $ map (PRIVMSG recipient) msgs, w)
126 recipient = case (\(CSepList [t:_]) -> t.[0]) t of
128 _ -> CSepList [user.irc_nick]
129 process` _ (PING t mt) w = (Just [PONG t mt], w)
130 process` _ _ w = (Just [], w)
132 realProcess :: [String] *World -> ([String], *World)
133 realProcess ["help",x:xs] w = ((case x of
135 [ "Usage: !help [ARG]"
136 , "Show this help, or the specific help of the argument"]
138 [ "Usage: !ping [ARG [ARG ...]]"
139 , "Ping the bot, it will pong the arguments back"]
141 [ "Usage: !shorten URL [URL [URL ...]]"
142 , "Shorten the given urls with the cloo.gl url shortener"]
144 [ "Usage: !query QUERY"
145 , "Query QUERY in cloogle and return the results"]
149 x = ["Unknown command: " +++ x]
151 realProcess ["help"] w = (
152 ["Type !help cmd for command specific help"
153 ,"available commands: help, ping, shorten, query, restart"], w)
154 realProcess ["ping":xs] w = (["pong " +++ join " " xs], w)
155 realProcess ["shorten":xs] w = case xs of
156 [] = (["shorten requires at least one argument"], w)
157 xs = mapSt shorten xs w
158 realProcess ["query":xs] w = case xs of
159 [] = (["query requires one or more arguments"], w)
160 xs = appFst (split "\n") $ cloogle (join " " xs) w
161 realProcess ["restart":_] w = (["restart takes no arguments"], w)
162 realProcess [c:_] w = ([join " " [
163 "Unknown cmd: ", c, ", type !help to get help"]], w)