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