cloogleirc.icl

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