module cloogle
+import Cloogle
import GenPrint
import IRC
import StdEnv
from Data.Func import $
from Text import class Text(..), instance Text String, instance + String
+import Text.JSON
+
import Text.URI
import Control.Applicative
commands :: [String]
commands = map toString
- [NICK "clooglebot"
- ,USER "cloogle" 0 "Cloogle bot"
+ [NICK "clooglebot" Nothing
+ ,USER "cloogle" "0" "Cloogle bot"
,JOIN [("#cloogle", Nothing)]
]
{ 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
| isError mer = ("request failed: " + fromError mer, w)
# resp = fromOk mer
-= (resp.rsp_data, w)
-
-send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
-send [] chan w = (chan, w)
-send [msg:msgs] {sChannel,rChannel} w
-# (rpt,i,sChannel,w) = send_MT TIMEOUT (toByteSeq msg) sChannel w
-| rpt <> TR_Success = abort "Could not send request\n"
-= send msgs {sChannel=sChannel,rChannel=rChannel} w
-
-recv :: TCP_DuplexChannel *World -> (Maybe String, TCP_DuplexChannel, *World)
-recv {sChannel,rChannel} w
-# (rpt, resp, rChannel, w) = receive_MT TIMEOUT rChannel w
-| rpt == TR_Expired = (Nothing, {sChannel=sChannel,rChannel=rChannel}, w)
-| rpt == TR_NoSuccess || isNothing resp = abort "Halp?\n"
-= (toString <$> resp, {sChannel=sChannel,rChannel=rChannel}, w)
-
-msg :: (String -> IRCCommands)
-msg = PRIVMSG "#cloogle"
-
-process :: *File TCP_DuplexChannel *World -> (*File, TCP_DuplexChannel, *World)
-process io chan w
-# (mr, chan, w) = recv chan w
-| isNothing mr = process io chan w
-# resp = fromJust mr
-#! io = io <<< ("Received: " +++ resp +++ "\n")
-# ind = indexOf KEY resp
-| ind >= 0
- # cmd = split " " $ rtrim $ subString (ind + size KEY) (size resp) resp
- #! io = io <<< ("Received command: " +++ printToString cmd +++ "\n")
- # (w, toSend) = case cmd of
+= 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)
+ where
+ processResults :: Response -> String
+ processResults resp
+ | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
+ = join "\n" $ map processResult $ take 3 resp.data
+
+ processResult :: Result -> String
+ processResult (FunctionResult (br, {func}))
+ = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
+ processResult (TypeResult (br, {type}))
+ = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
+ 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
+
+ limitResults :: String -> String
+ limitResults s
+ # lines = split "\n" s
+ | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
+ = join "\n" (map maxWidth lines)
+
+ maxWidth :: String -> String
+ maxWidth s
+ | 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 [msg s])
+ = (w, Just $ map msg $ split "\n" s)
["short"] = (w, Just [msg $ "short requires an url argument"])
["short":xs]
# (s, w) = shorten (join " " xs) w
"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"]])
- | isNothing toSend = (io, chan, w)
- # (chan, w) = send (map toString $ fromJust toSend) chan w
- = process io chan w
-| indexOf "PING :" resp >= 0
- # cmd = rtrim $ subString (indexOf "PING :" resp + size "PING :") (size resp) resp
- #! io = io <<< (toString $ PONG cmd Nothing) <<< "\n"
- # (chan, w) = send [toString $ PONG cmd Nothing] chan w
- = process io chan w
-= process io chan w
-
-Start :: *World -> (String, *World)
-Start w = cloogle "Monad" w
-//Start :: *World -> *World
-//Start w
-//# (io, w) = stdio w
-//# (ip, w) = lookupIPAddress SERVER w
-//| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
-//# (Just ip) = ip
-//# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
-//| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
-//| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
-//# chan = fromJust chan
-//# (chan, w) = send commands chan w
-//# (io, chan, w) = process io chan w
-//# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
-//# (_, w) = fclose io w
-//= closeChannel sChannel (closeRChannel rChannel w)
+*/
+
+Start :: *World -> (MaybeErrorString (), *World)
+Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w
+ where
+ toPrefix c = {irc_prefix=Nothing,irc_command=c}
+ startup = map toPrefix
+ [NICK "clooglebot" Nothing
+ ,USER "cloogle" "0" "Cloogle bot"
+ ,JOIN [("#cloogle", 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"]]
repositories / cloogle-irc.git / blobdiff