X-Git-Url: https://git.martlubbers.net/?p=cloogle-irc.git;a=blobdiff_plain;f=cloogle.icl;h=b2c7bdfe66c0c5b346be0a04c575d8e6df952e55;hp=b1303000dc9ef822275c07be4437591d44dd38b9;hb=befcf2ab2ca4e80eebcbd839ce4a0375ae9a6012;hpb=3134ab7e61bcbc84560b4a5d613a92b1a48362c2 diff --git a/cloogle.icl b/cloogle.icl index b130300..b2c7bdf 100644 --- a/cloogle.icl +++ b/cloogle.icl @@ -2,14 +2,16 @@ module cloogle import Cloogle import GenPrint -import IRC import StdEnv import Data.Functor import Data.Maybe -from Data.Func import $ +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 @@ -26,85 +28,17 @@ import Data.Functor import Data.Tuple import TCPIP - -commands :: [String] -commands = map toString - [NICK "clooglebot" Nothing - ,USER "cloogle" "0" "Cloogle bot" - ,JOIN [("#cloogle", Nothing)] - ] +import IRC +import IRCBot TIMEOUT :== Just 10000 SERVER :== "irc.freenode.net" -KEY :== "PRIVMSG #cloogle :!" - -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 numbe 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 = "/" @@ -114,26 +48,27 @@ 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 Nothing = ("couldn't parse json", w) - Just clr = ("Results for " + data + " -- https://cloogle.org/#" + replaceSubString "+" "%20" (urlEncode data) + "\n" + - processResults clr, w) + Just clr = ("Results for " + data + " -- https://cloogle.org/#" + + replaceSubString "+" "%20" (urlEncode data) + "\n" + + processResults clr, w) where processResults :: Response -> String processResults resp @@ -148,8 +83,6 @@ cloogle data w processResult (ClassResult (br, {class_name,class_funs})) = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with " +++ toString (length class_funs) +++ " class functions" - processResult (MacroResult (br, {macro_name})) - = "Macro in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ macro_name processResult (ModuleResult (br, _)) = "Module in " +++ br.library +++ ": " +++ br.modul @@ -164,52 +97,67 @@ cloogle data w | size s > 80 = subString 0 77 s + "..." = s -/* - ["stop":_] = (w, Nothing) - ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs]) - ["query":xs] - # (s, w) = cloogle (join " " xs) w - = (w, Just $ map msg $ split "\n" s) - ["short"] = (w, Just [msg $ "short requires an url argument"]) - ["short":xs] - # (s, w) = shorten (join " " xs) w - = (w, Just [msg s]) - ["help"] = (w, Just - [msg "type !help cmd for command specific help" - ,msg "available commands: help, ping, query, short"]) - ["help":c:_] = (w, case c of - "help" = Just [msg "help [CMD] - I will print general help or the help of CMD"] - "ping" = Just [msg "ping [TXT] - I will reply with pong and the optionar TXT"] - "query" = Just [msg "query QUERY - I will send QUERY to cloogle and post the results"] - "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"] - _ = Just [msg "Unknown command"]) - [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]]) -*/ Start :: *World -> (MaybeErrorString (), *World) Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w where - toPrefix c = {irc_prefix=Nothing,irc_command=c} + toPrefix c = {irc_prefix=Nothing,irc_command=Right c} startup = map toPrefix [NICK "clooglebot" Nothing - ,USER "cloogle" "0" "Cloogle bot" - ,JOIN [("#cloogle", Nothing)]] - shutdown = map toPrefix [QUIT (Just "Bye")] + ,USER "cloogle" "cloogle" "cloogle" "Cloogle bot" + ,JOIN (CSepList ["#cloogle", "#cleanlang"]) Nothing] + shutdown = map toPrefix [QUIT $ Just "Bye"] process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World) - process im s w = case process` im.irc_command w of - (Nothing, w) = (Nothing, (), w) - (Just cs, w) = (Just $ map toPrefix cs, (), w) - - process` :: IRCCommand *World -> (Maybe [IRCCommand], *World) - process` (PRIVMSG t m) w = (Just $ if (startsWith "!" m) - (map (PRIVMSG t) $ realProcess $ split " " $ subString 1 (size m) m) - [], w) - process` (PING t mt) w = (Just [PONG t mt], w) - process` _ w = (Just [], w) - - realProcess :: [String] -> [String] - realProcess ["help":xs] = - ["type !help cmd for command specific help" - ,"available commands: help"] - realProcess [c:_] = [join " " ["unknown cmd: ", c, ", type !help to get help"]] + process im s w = case im.irc_command of + Left numr = (Just [], (), w) + Right cmd = case process` im.irc_prefix cmd w of + (Nothing, w) = (Nothing, (), w) + (Just cs, w) = (Just $ map toPrefix cs, (), w) + + process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World) + process` (Just (Left user)) (PRIVMSG t m) w + | m == "!restart" = (Nothing, w) + | m.[0] == '!' + # (msgs, w) = realProcess (split " " $ m % (1, size m)) w + = (Just $ map (PRIVMSG recipient) msgs, w) + = (Just [], w) + where + recipient = case (\(CSepList [t:_]) -> t.[0]) t of + '#' -> t + _ -> CSepList [user.irc_nick] + process` _ (PING t mt) w = (Just [PONG t mt], w) + process` _ _ w = (Just [], w) + + realProcess :: [String] *World -> ([String], *World) + realProcess ["help",x:xs] w = ((case x of + "help" = + [ "Usage: !help [ARG]" + , "Show this help, or the specific help of the argument"] + "ping" = + [ "Usage: !ping [ARG [ARG ...]]" + , "Ping the bot, it will pong the arguments back"] + "shorten" = + [ "Usage: !shorten URL [URL [URL ...]]" + , "Shorten the given urls with the cloo.gl url shortener"] + "query" = + [ "Usage: !query QUERY" + , "Query QUERY in cloogle and return the results"] + "restart" = + [ "Usage: !restart" + , "Restart the bot"] + x = ["Unknown command: " +++ x] + ), w) + realProcess ["help"] w = ( + ["Type !help cmd for command specific help" + ,"available commands: help, ping, shorten, query, restart"], w) + realProcess ["ping":xs] w = (["pong " +++ join " " xs], w) + realProcess ["shorten":xs] w = case xs of + [] = (["shorten requires at least one argument"], w) + xs = mapSt shorten xs w + realProcess ["query":xs] w = case xs of + [] = (["query requires one or more arguments"], w) + xs = appFst (split "\n") $ cloogle (join " " xs) w + realProcess ["restart":_] w = (["restart takes no arguments"], w) + realProcess [c:_] w = ([join " " [ + "Unknown cmd: ", c, ", type !help to get help"]], w)