cloogle.icl

   1 module cloogle
   2
   3 import Cloogle
   4 import GenPrint
   5 import StdEnv
   6
   7 import Data.Functor
   8 import Data.Maybe
   9 import Data.Either
  10 from Data.Func import $, mapSt
  11 from Text import class Text(..), instance Text String, instance + String
  12
  13 import Internet.HTTP
  14
  15 import Text.JSON
  16
  17 import Text.URI
  18
  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
  24 import Internet.HTTP
  25 import Data.Error
  26 import Data.List
  27 import Data.Functor
  28 import Data.Tuple
  29
  30 import TCPIP
  31 import IRC
  32 import IRCBot
  33
  34 TIMEOUT :== Just 10000
  35 SERVER :== "irc.freenode.net"
  36
  37 shorten :: String *World -> (String, *World)
  38 shorten s w
  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
  42                 { newHTTPRequest
  43                 & req_method = HTTP_POST
  44                 , req_path = "/"
  45                 , server_name = "cloo.gl"
  46                 , server_port = 80
  47                 , req_headers = 'DM'.fromList
  48                         [("Content-Type", "application/x-www-form-urlencoded")
  49                         ,("Content-Length", toString $ size data)
  50                         ,("Accept", "*/*")]
  51                 , req_data = data} 10000 w
  52 | isError mer = ("request failed: " + fromError mer, w)
  53 # resp = fromOk mer
  54 = (resp.rsp_data, w)
  55
  56 cloogle :: String *World -> (String, *World)
  57 cloogle data w
  58 # (mer, w) = doHTTPRequestL
  59                 { newHTTPRequest
  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)
  66 # resp = fromOk mer
  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)
  72         where
  73                 processResults :: Response -> String
  74                 processResults resp
  75                 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
  76                 = join "\n" $ map processResult $ take 3 resp.data
  77
  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
  88
  89                 limitResults :: String -> String
  90                 limitResults s
  91                 # lines = split "\n" s
  92                 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
  93                 = join "\n" (map maxWidth lines)
  94
  95                 maxWidth :: String -> String
  96                 maxWidth s
  97                 | size s > 80 = subString 0 77 s + "..."
  98                 = s
  99
 100
 101 Start :: *World -> (MaybeErrorString (), *World)
 102 Start w = bot ("irc.freenode.net", 6667) startup shutdown () process w
 103         where
 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"]
 110
 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)
 117
 118                 process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World)
 119                 process` (Just (Left user)) (PRIVMSG t m) w
 120                         | m.[0] == '!'
 121                                 # (msgs, w) = realProcess (split " " $ m % (1, size m)) w
 122                                 = (Just $ map (PRIVMSG recipient) msgs, w)
 123                         = (Just [], w)
 124                 where
 125                         recipient = case (\(CSepList [t:_]) -> t.[0]) t of
 126                                 '#' -> t
 127                                 _   -> CSepList [user.irc_nick]
 128                 process` _ (PING t mt) w = (Just [PONG t mt], w)
 129                 process` _ _ w = (Just [], w)
 130
 131                 realProcess :: [String] *World -> ([String], *World)
 132                 realProcess ["help",x:xs] w = ((case x of
 133                         "help" =
 134                                 [ "Usage: !help [ARG]"
 135                                 , "Show this help, or the specific help of the argument"]
 136                         "ping" =
 137                                 [ "Usage: !ping [ARG [ARG ...]]"
 138                                 , "Ping the bot, it will pong the arguments back"]
 139                         "shorten" =
 140                                 [ "Usage: !shorten URL [URL [URL ...]]"
 141                                 , "Shorten the given urls with the cloo.gl url shortener"]
 142                         "query" =
 143                                 [ "Usage: !query QUERY"
 144                                 , "Query QUERY in cloogle and return the results"]
 145                         "restart" =
 146                                 [ "Usage: !restart"
 147                                 , "Restart the bot"]
 148                         x = ["Unknown command: " +++ x]
 149                         ), w)
 150                 realProcess ["help"] w = (
 151                         ["Type !help cmd for command specific help"
 152                         ,"available commands: help, ping, shorten, query, restart"], w)
 153                 realProcess ["ping":xs] w = (["pong " +++ join " " xs], w)
 154                 realProcess ["shorten":xs] w = case xs of
 155                         [] = (["shorten requires at least one argument"], w)
 156                         xs = mapSt shorten xs w
 157                 realProcess ["query":xs] w = case xs of
 158                         [] = (["query requires one or more arguments"], w)
 159                         xs = appFst (split "\n") $ cloogle (join " " xs) w
 160                 realProcess ["restart"] w = abort "Restarted"
 161                 realProcess ["restart":_] w = (["restart takes no arguments"], w)
 162                 realProcess [c:_] w = ([join " " [
 163                         "Unknown cmd: ", c, ",  type !help to get help"]], w)