cloogleirc.icl

   1 module cloogleirc
   2
   3 import Cloogle
   4 import Text.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.GenJSON
  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(bind), >>=
  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 import StdMisc, StdDebug
  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) = doHTTPRequestFollowRedirects
  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 {return=127} = ("No results for " + data, w)
  71         Just clr = ("Results for " + data + " -- https://cloogle.org/#" +
  72                 replaceSubString "+" "%20" (urlEncode data) + "\n" +
  73                 processResults clr, w)
  74         where
  75                 processResults :: Response -> String
  76                 processResults resp
  77                 | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
  78                 = join "\n" $ map processResult $ take 3 resp.data
  79
  80                 processResult :: Result -> String
  81                 processResult (FunctionResult (br, {func}))
  82                         = "Function in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ func
  83                 processResult (TypeResult (br, {type}))
  84                         = "Type in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ limitResults type
  85                 processResult (ClassResult (br, {class_name,class_funs}))
  86                         = "Class in " +++ br.library +++ ": " +++ br.modul +++ "\n" +++ class_name +++ " with "
  87                                 +++ toString (length class_funs) +++ " class functions"
  88                 processResult (ModuleResult (br, _))
  89                         = "Module in " +++ br.library +++ ": " +++ br.modul
  90                 processResult (SyntaxResult (br, re))
  91                         = "Clean syntax: " +++ re.syntax_title +++ "\n"
  92                                 +++ concat (intersperse "; " re.syntax_code)
  93                 processResult (ABCInstructionResult (br, re))
  94                         = "ABC instruction: " +++ re.abc_instruction
  95                 processResult (ProblemResult pr)
  96                         = "Common problem: " +++ pr.problem_title
  97                                 +++ "; see https://github.com/clean-cloogle/common-problems/blob/master/" +++ pr.problem_key +++ ".md"
  98
  99                 limitResults :: String -> String
 100                 limitResults s
 101                 # lines = split "\n" s
 102                 | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
 103                 = join "\n" (map maxWidth lines)
 104
 105                 maxWidth :: String -> String
 106                 maxWidth s = if (size s > 80) (subString 0 77 s + "...") s
 107
 108 :: BotSettings =
 109                 { bs_nick     :: String
 110                 , bs_nickserv :: Maybe String
 111                 , bs_autojoin :: [String]
 112                 , bs_port     :: Int
 113                 , bs_server   :: String
 114                 , bs_strftime :: String
 115                 }
 116
 117 Start :: *World -> (Maybe String, *World)
 118 Start w
 119 # ([cmd:args], w) = getCommandLine w
 120 # (io, w) = stdio w
 121 # bs = parseCLI cmd args
 122 | isError bs
 123         # io = io <<< fromError bs <<< "\n"
 124         = (Nothing, snd $ fclose io w)
 125 # (Ok bs) = bs
 126 # (_, w) = fclose io w
 127 # (merr, _, w) = bot (bs.bs_server, bs.bs_port) (startup bs) shutdown () (process bs.bs_strftime) w
 128 = (merr, w)
 129         where
 130                 parseCLI :: String [String] -> MaybeErrorString BotSettings
 131                 parseCLI _ [] = Ok
 132                         { bs_nick     = "clooglebot"
 133                         , bs_nickserv = Nothing
 134                         , bs_autojoin = []
 135                         , bs_port     = 6667
 136                         , bs_server   = "irc.freenode.net"
 137                         , bs_strftime = "%s"
 138                         }
 139                 parseCLI cmd [a:as]
 140                 | a == "-f" || a == "--strftime"
 141                         = arg1 "--strftime" as \a c->{c & bs_strftime=a}
 142                 | a == "-n" || a == "--nick"
 143                         = arg1 "--nick" as \a c->{c & bs_nick=a}
 144                 | a == "-ns" || a == "--nickserv"
 145                         = arg1 "--nickserv" as \a c->{c & bs_nickserv=Just a}
 146                 | a == "-a" || a == "--autojoin"
 147                         = arg1 "--autojoin" as \a c->{c & bs_autojoin=c.bs_autojoin ++ [a]}
 148                 | a == "-p" || a == "--port"
 149                         = arg1 "--port" as \a c->{c & bs_port=toInt a}
 150                 | a == "-s" || a == "--server"
 151                         = arg1 "--server" as \a c->{c & bs_server=a}
 152                 | a == "-h" || a == "--help" = Error $ join "\n" $
 153                         [ "Usage: " + cmd + " [OPTS]"
 154                         , "Options:"
 155                         , "\t--strftime/-f FORMAT   strftime format used in the output. default: %s\n"
 156                         , "\t--nick/-n NICKNAME     Use the given nickname instead of clooglebot"
 157                         , "\t--nickserv/-ns PW      Identify via the given password with NickServ"
 158                         , "\t--port/-p PORT         Use the given port instead of port 6667"
 159                         , "\t--server/-s SERVER     Use the given server instead of irc.freenode.net"
 160                         , "\t--autojoin/-a CHANNEL  Add CHANNEL to the autojoin list. This command "
 161                         , "\t                       can be called multiple times. Beware that #"
 162                         , "\t                       has to be escaped in most shells"
 163                         ]
 164                 = Error $ "Unknown option: " +++ a
 165                 where
 166                         arg1 name [] _ = Error $ name +++ " requires an argument"
 167                         arg1 name [a:as] f = parseCLI cmd as >>= Ok o f a
 168
 169                 nickserv pw = PRIVMSG (CSepList ["NickServ"]) $ "IDENTIFY " +++ pw
 170
 171                 toPrefix c = {irc_prefix=Nothing,irc_command=Right c}
 172
 173                 startup bs = map toPrefix $
 174                         [   NICK bs.bs_nick Nothing
 175                         ,   USER "cloogle" "cloogle" "cloogle" "Cloogle bot"
 176                         ]++ maybe [] (pure o nickserv) bs.bs_nickserv
 177                          ++ if (isEmpty bs.bs_autojoin) []
 178                                 [JOIN (CSepList bs.bs_autojoin) Nothing]
 179                 shutdown = map toPrefix [QUIT $ Just "Bye"]
 180
 181                 process :: String !IRCMessage () !*World -> (Maybe [IRCMessage], (), !*World)
 182                 process strf im _ w
 183                 # (io ,w) = stdio w
 184                 # (io, w) = log strf " (r): " im (io, w)
 185                 # (_, w) = fclose io w
 186                 = case im.irc_command of
 187                         Left numr = (Just [], (), w)
 188                         Right cmd = case process` im.irc_prefix cmd w of
 189                                 (Nothing, w) = (Nothing, (), w)
 190                                 (Just cs, w)
 191                                 # msgs = map toPrefix cs
 192                                 = (Just msgs, (), w)
 193
 194                 log :: String String IRCMessage (!*File, !*World) -> (!*File, !*World)
 195                 log strf pref m (io, w)
 196                 #! (t, w) = localTime w
 197                 = (io <<< strfTime strf t <<< pref <<< toString m <<< "\n", w)
 198
 199                 process` :: (Maybe (Either IRCUser String)) IRCCommand *World -> (Maybe [IRCCommand], *World)
 200                 process` (Just (Left user)) (PRIVMSG t m) w
 201                         | m == "!restart" = (Nothing, w)
 202                         | m.[0] == '!'
 203                                 # (msgs, w) = realProcess (split " " $ m % (1, size m)) w
 204                                 = (Just $ map reply msgs, w)
 205                         | m % (0,4) == "\001PING" = (Just [reply m], w)
 206                         = (Just [], w)
 207                 where
 208                         reply = case (\(CSepList [t:_]) -> t.[0]) t of
 209                                 '#' -> PRIVMSG t
 210                                 _   -> NOTICE user.irc_nick
 211                 process` _ (PING t mt) w = (Just [PONG t mt], w)
 212                 process` _ _ w = (Just [], w)
 213
 214                 realProcess :: [String] *World -> ([String], *World)
 215                 realProcess ["help",x:xs] w = ((case x of
 216                         "help" =
 217                                 [ "Usage: !help [ARG]"
 218                                 , "Show this help, or the specific help of the argument"]
 219                         "ping" =
 220                                 [ "Usage: !ping [ARG [ARG ...]]"
 221                                 , "Ping the bot, it will pong the arguments back"]
 222                         "shorten" =
 223                                 [ "Usage: !shorten URL [URL [URL ...]]"
 224                                 , "Shorten the given urls with the cloo.gl url shortener"]
 225                         "query" =
 226                                 [ "Usage: !query QUERY"
 227                                 , "Query QUERY in cloogle and return the results"]
 228                         "restart" =
 229                                 [ "Usage: !restart"
 230                                 , "Restart the bot"]
 231                         x = ["Unknown command: " +++ x]
 232                         ), w)
 233                 realProcess ["help"] w = (
 234                         ["Type !help cmd for command specific help"
 235                         ,"available commands: help, ping, shorten, query, restart"], w)
 236                 realProcess ["ping":xs] w = (["pong " +++ join " " xs], w)
 237                 realProcess ["shorten":xs] w = case xs of
 238                         [] = (["shorten requires at least one argument"], w)
 239                         xs = mapSt shorten xs w
 240                 realProcess ["query":xs] w = case xs of
 241                         [] = (["query requires one or more arguments"], w)
 242                         xs = appFst (split "\n") $ cloogle (join " " xs) w
 243                 realProcess ["restart":_] w = (["restart takes no arguments"], w)
 244                 realProcess [c:_] w = ([join " " [
 245                         "Unknown cmd: ", c, ",  type !help to get help"]], w)