cloogleirc.icl

   1 module cloogleirc
   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 System.CommandLine
  25 import Internet.HTTP
  26 import Data.Error
  27 import Data.List
  28 import Data.Functor
  29 import Data.Tuple
  30
  31 import TCPIP
  32 import IRC
  33 import IRCBot
  34
  35 TIMEOUT :== Just 10000
  36 SERVER :== "irc.freenode.net"
  37
  38 shorten :: String *World -> (String, *World)
  39 shorten s w
  40 # s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s))
  41 # data = "type=regular&url="+urlEncode s+"&token=a"
  42 # (mer, w) = doHTTPRequest
  43                 { newHTTPRequest
  44                 & req_method = HTTP_POST
  45                 , req_path = "/"
  46                 , server_name = "cloo.gl"
  47                 , server_port = 80
  48                 , req_headers = 'DM'.fromList
  49                         [("Content-Type", "application/x-www-form-urlencoded")
  50                         ,("Content-Length", toString $ size data)
  51                         ,("Accept", "*/*")]
  52                 , req_data = data} 10000 w
  53 | isError mer = ("request failed: " + fromError mer, w)
  54 # resp = fromOk mer
  55 = (resp.rsp_data, w)
  56
  57 cloogle :: String *World -> (String, *World)
  58 cloogle data w
  59 # (mer, w) = doHTTPRequestL
  60                 { newHTTPRequest
  61                 & req_path = "/api.php"
  62                 , req_query = "?str=" + urlEncode data
  63                 , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
  64                 , server_name = "cloogle.org"
  65                 , server_port = 80} 10000 10 w
  66 | isError mer = ("request failed: " + fromError mer, w)
  67 # resp = fromOk mer
  68 = case fromJSON $ fromString resp.HTTPResponse.rsp_data of
  69         Nothing = ("couldn't parse json", w)
  70         Just clr = ("Results for " + data + " -- https://cloogle.org/#" +
  71                 replaceSubString "+" "%20" (urlEncode data) + "\n" +
  72                 processResults clr, w)
  73         where
  74                 processResults :: Response -> String
  75                 processResults resp
  76                 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
  77                 = join "\n" $ map processResult $ take 3 resp.data
  78
  79                 processResult :: Result -> String
  80                 processResult (FunctionResult (br, {func}))
  81                         = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
  82                 processResult (TypeResult (br, {type}))
  83                         = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
  84                 processResult (ClassResult (br, {class_name,class_funs}))
  85                         = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
  86                                 +++ toString (length class_funs) +++ " class functions"
  87                 processResult (ModuleResult (br, _))
  88                         = "Module in " +++ br.library +++ ": " +++ br.modul
  89
  90                 limitResults :: String -> String
  91                 limitResults s
  92                 # lines = split "\n" s
  93                 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
  94                 = join "\n" (map maxWidth lines)
  95
  96                 maxWidth :: String -> String
  97                 maxWidth s
  98                 | size s > 80 = subString 0 77 s + "..."
  99                 = s
 100
 101 :: BotSettings =
 102                 { bs_nick     :: String
 103                 , bs_nickserv :: Maybe String
 104                 , bs_autojoin :: [String]
 105                 , bs_port     :: Int
 106                 , bs_server   :: String
 107                 }
 108
 109 Start :: *World -> (MaybeErrorString (), *World)
 110 Start w
 111 # ([arg0:args], w) = getCommandLine w
 112 # bs = parseCLI args
 113 | isError bs = (Error $ "\n" +++ fromError bs +++ "\n", w)
 114 # (Ok bs) = bs
 115 = bot (bs.bs_server, bs.bs_port) (startup bs) shutdown () process w
 116         where
 117                 parseCLI :: [String] -> MaybeErrorString BotSettings
 118                 parseCLI [] = Ok
 119                         { bs_nick     = "clooglebot"
 120                         , bs_nickserv = Nothing
 121                         , bs_autojoin = []
 122                         , bs_port     = 6667
 123                         , bs_server   = "irc.freenode.net"
 124                         }
 125                 parseCLI [a:as]
 126                 | a == "-n" || a == "--nick"
 127                         = arg1 "--nick" as \a c->{c & bs_nick=a}
 128                 | a == "-ns" || a == "--nickserv"
 129                         = arg1 "--nickserv" as \a c->{c & bs_nickserv=Just a}
 130                 | a == "-a" || a == "--autojoin"
 131                         = arg1 "--autojoin" as \a c->{c & bs_autojoin=c.bs_autojoin ++ [a]}
 132                 | a == "-p" || a == "--port"
 133                         = arg1 "--port" as \a c->{c & bs_port=toInt a}
 134                 | a == "-s" || a == "--server"
 135                         = arg1 "--port" as \a c->{c & bs_server=a}
 136                 | a == "-h" || a == "--help" = Error $ join "\n" $
 137                         [ "Usage: cloogle [OPTS]"
 138                         , "Options:"
 139                         , "\t--nick/-n NICKNAME     Use the given nickname instead of clooglebot"
 140                         , "\t--nickserv/-ns PW      Identify via the given password with NickServ"
 141                         , "\t--port/-p PORT         Use the given port instead of port 6667"
 142                         , "\t--server/-s SERVER     Use the given server instead of irc.freenode.net"
 143                         , "\t--autojoin/-a CHANNEL  Add CHANNEL to the autojoin list. This command "
 144                         , "\t                       can be called multiple times. Beware that #"
 145                         , "\t                       has to be escaped in most shells"
 146                         ]
 147                 = Error $ "Unknown option: " +++ a
 148
 149                 arg1 name [] _ = Error $ name +++ " requires an argument"
 150                 arg1 name [a:as] f = parseCLI as >>= Ok o f a
 151
 152                 nickserv pw = PRIVMSG (CSepList ["NickServ"]) $ "IDENTIFY " +++ pw
 153
 154                 toPrefix c = {irc_prefix=Nothing,irc_command=Right c}
 155
 156                 startup bs = map toPrefix $
 157                         [   NICK bs.bs_nick Nothing
 158                         ,   USER "cloogle" "cloogle" "cloogle" "Cloogle bot"
 159                         ]++ maybe [] (pure o nickserv) bs.bs_nickserv
 160                          ++ if (isEmpty bs.bs_autojoin) []
 161                                 [JOIN (CSepList bs.bs_autojoin) Nothing]
 162                 shutdown = map toPrefix [QUIT $ Just "Bye"]
 163
 164                 process :: IRCMessage () *World -> (Maybe [IRCMessage], (), *World)
 165                 process im s w = case im.irc_command of
 166                         Left numr = (Just [], (), w)
 167                         Right cmd = case process` im.irc_prefix cmd w of
 168                                 (Nothing, w) = (Nothing, (), w)
 169                                 (Just cs, w) = (Just $ map toPrefix cs, (), w)
 170
 171                 process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World)
 172                 process` (Just (Left user)) (PRIVMSG t m) w
 173                         | m == "!restart" = (Nothing, w)
 174                         | m.[0] == '!'
 175                                 # (msgs, w) = realProcess (split " " $ m % (1, size m)) w
 176                                 = (Just $ map (PRIVMSG recipient) msgs, w)
 177                         = (Just [], w)
 178                 where
 179                         recipient = case (\(CSepList [t:_]) -> t.[0]) t of
 180                                 '#' -> t
 181                                 _   -> CSepList [user.irc_nick]
 182                 process` _ (PING t mt) w = (Just [PONG t mt], w)
 183                 process` _ _ w = (Just [], w)
 184
 185                 realProcess :: [String] *World -> ([String], *World)
 186                 realProcess ["help",x:xs] w = ((case x of
 187                         "help" =
 188                                 [ "Usage: !help [ARG]"
 189                                 , "Show this help, or the specific help of the argument"]
 190                         "ping" =
 191                                 [ "Usage: !ping [ARG [ARG ...]]"
 192                                 , "Ping the bot, it will pong the arguments back"]
 193                         "shorten" =
 194                                 [ "Usage: !shorten URL [URL [URL ...]]"
 195                                 , "Shorten the given urls with the cloo.gl url shortener"]
 196                         "query" =
 197                                 [ "Usage: !query QUERY"
 198                                 , "Query QUERY in cloogle and return the results"]
 199                         "restart" =
 200                                 [ "Usage: !restart"
 201                                 , "Restart the bot"]
 202                         x = ["Unknown command: " +++ x]
 203                         ), w)
 204                 realProcess ["help"] w = (
 205                         ["Type !help cmd for command specific help"
 206                         ,"available commands: help, ping, shorten, query, restart"], w)
 207                 realProcess ["ping":xs] w = (["pong " +++ join " " xs], w)
 208                 realProcess ["shorten":xs] w = case xs of
 209                         [] = (["shorten requires at least one argument"], w)
 210                         xs = mapSt shorten xs w
 211                 realProcess ["query":xs] w = case xs of
 212                         [] = (["query requires one or more arguments"], w)
 213                         xs = appFst (split "\n") $ cloogle (join " " xs) w
 214                 realProcess ["restart":_] w = (["restart takes no arguments"], w)
 215                 realProcess [c:_] w = ([join " " [
 216                         "Unknown cmd: ", c, ",  type !help to get help"]], w)