-- | Simple template module
-- Contains many constant bot commands.
module Lambdabot.Plugin.Misc.Dummy (dummyPlugin) where

import Lambdabot.Plugin
import Lambdabot.Plugin.Misc.Dummy.DocAssocs (docAssocs)
import Lambdabot.Util

import Data.Char
import qualified Data.ByteString.Char8 as P
import qualified Data.Map as M
import System.FilePath

dummyPlugin :: Module ()
dummyPlugin :: Module ()
dummyPlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        ([Command (ModuleT () LB)]
 -> ModuleT () LB [Command (ModuleT () LB)])
-> [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall a b. (a -> b) -> a -> b
$ (String -> Command Identity
command "eval")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "eval. Do nothing (perversely)"
            , process :: String -> Cmd (ModuleT () LB) ()
process = Cmd (ModuleT () LB) () -> String -> Cmd (ModuleT () LB) ()
forall a b. a -> b -> a
const (() -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
            }
        Command (ModuleT () LB)
-> [Command (ModuleT () LB)] -> [Command (ModuleT () LB)]
forall a. a -> [a] -> [a]
: (String -> Command Identity
command "choose")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "choose. Lambdabot featuring AI power"
            , process :: String -> Cmd (ModuleT () LB) ()
process = \args :: String
args ->
                if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
args then String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "Choose between what?"
                    else String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT () LB) ())
-> Cmd (ModuleT () LB) String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO String -> Cmd (ModuleT () LB) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String -> Cmd (ModuleT () LB) String)
-> (String -> IO String) -> String -> Cmd (ModuleT () LB) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO String
forall (m :: * -> *) a. MonadIO m => [a] -> m a
random ([String] -> IO String)
-> (String -> [String]) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Cmd (ModuleT () LB) String)
-> String -> Cmd (ModuleT () LB) String
forall a b. (a -> b) -> a -> b
$ String
args)
            }
        Command (ModuleT () LB)
-> [Command (ModuleT () LB)] -> [Command (ModuleT () LB)]
forall a. a -> [a] -> [a]
: [ (String -> Command Identity
command String
cmd)
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> String
dummyHelp String
cmd)
            , process :: String -> Cmd (ModuleT () LB) ()
process = (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say ([String] -> Cmd (ModuleT () LB) ())
-> (String -> [String]) -> String -> Cmd (ModuleT () LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
op
            }
          | (cmd :: String
cmd, op :: String -> String
op) <- [(String, String -> String)]
dummylst
          ]
    }

dummyHelp :: String -> String
dummyHelp :: String -> String
dummyHelp s :: String
s = case String
s of
    "dummy"       -> "dummy. Print a string constant"
    "bug"         -> "bug. Submit a bug to GHC's trac"
    "id"          -> "id <arg>. The identity plugin"
    "show"        -> "show <foo>. Print \"<foo>\""
    "wiki"        -> "wiki <page>. URLs of Haskell wiki pages"
    "paste"       -> "paste. Paste page url"
    "docs"        -> "docs <lib>. Lookup the url for this library's documentation"
    "learn"       -> "learn. The learning page url"
    "haskellers"  -> "haskellers. Find other Haskell users"
    "botsnack"    -> "botsnack. Feeds the bot a snack"
    "get-shapr"   -> "get-shapr. Summon shapr instantly"
    "shootout"    -> "shootout. The debian language shootout"
    "faq"         -> "faq. Answer frequently asked questions about Haskell"
    "googleit"    -> "letmegooglethatforyou."
    "hackage"     -> "find stuff on hackage"
    _             -> "I'm sorry Dave, I'm afraid I don't know that command"

dummylst :: [(String, String -> String)]
dummylst :: [(String, String -> String)]
dummylst =
    [("dummy"      , String -> String -> String
forall a b. a -> b -> a
const "dummy")
    ,("bug"        , String -> String -> String
forall a b. a -> b -> a
const "https://gitlab.haskell.org/ghc/ghc/issues")
    ,("id"         , (' ' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. a -> a
id)
    ,("show"       , String -> String
forall a. Show a => a -> String
show)
    ,("wiki"       , String -> String
lookupWiki)
    ,("paste"      , String -> String -> String
forall a b. a -> b -> a
const "A pastebin: https://paste.debian.net/")
    ,("docs"       , \x :: String
x -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x
                           then String
docPrefix String -> String -> String
</> "index.html"
                           else String -> Char -> String -> String -> String
lookupPackage String
docPrefix '-' "html" String
x)
    ,("learn"      , String -> String -> String
forall a b. a -> b -> a
const "https://wiki.haskell.org/Learning_Haskell")
    ,("haskellers" , String -> String -> String
forall a b. a -> b -> a
const "https://www.haskellers.com/")
    ,("botsnack"   , String -> String -> String
forall a b. a -> b -> a
const ":)")
    ,("get-shapr"  , String -> String -> String
forall a b. a -> b -> a
const "shapr!!")
    ,("shootout"   , String -> String -> String
forall a b. a -> b -> a
const "https://benchmarksgame-team.pages.debian.net/benchmarksgame/")
    ,("faq"        , String -> String -> String
forall a b. a -> b -> a
const "The answer is: Yes! Haskell can do that.")
    ,("googleit"   , String -> String
lookupGoogle)
    ,("hackage"    , String -> String
lookupHackage)
    ,("thanks"     , String -> String -> String
forall a b. a -> b -> a
const "you are welcome")
    ,("thx"        , String -> String -> String
forall a b. a -> b -> a
const "you are welcome")
    ,("thank you"  , String -> String -> String
forall a b. a -> b -> a
const "you are welcome")
    ,("ping"       , String -> String -> String
forall a b. a -> b -> a
const "pong")
    ,("tic-tac-toe", String -> String -> String
forall a b. a -> b -> a
const "how about a nice game of chess?")
    ]

lookupWiki :: String -> String
lookupWiki :: String -> String
lookupWiki page :: String
page = "https://wiki.haskell.org" String -> String -> String
</> String -> String
spacesToUnderscores String
page
  where spacesToUnderscores :: String -> String
spacesToUnderscores = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' then '_' else Char
c)

lookupHackage :: String -> String
lookupHackage :: String -> String
lookupHackage "" = "https://hackage.haskell.org"
lookupHackage xs :: String
xs = "https://hackage.haskell.org/package" String -> String -> String
</> String
xs

googlePrefix :: String
googlePrefix :: String
googlePrefix = "https://lmgtfy.com"

lookupGoogle :: String -> String
lookupGoogle :: String -> String
lookupGoogle "" = String
googlePrefix
lookupGoogle xs :: String
xs = String
googlePrefix String -> String -> String
</> "?q=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
xs
 where
    quote :: String -> String
quote = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' then '+' else Char
x)

docPrefix :: String
docPrefix :: String
docPrefix = "https://haskell.org/ghc/docs/latest/html/libraries"

lookupPackage :: String -> Char -> String -> String -> String
lookupPackage :: String -> Char -> String -> String -> String
lookupPackage begin :: String
begin sep :: Char
sep end :: String
end x'' :: String
x'' = 
    case ByteString
-> Map ByteString (ByteString, ByteString)
-> Maybe (ByteString, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
x') Map ByteString (ByteString, ByteString)
docAssocs of
        Nothing -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace String
x'' String -> String -> String
forall a. [a] -> [a] -> [a]
++ " not available"
        Just (x :: ByteString
x, m :: ByteString
m)  -> String
begin
               String -> String -> String
</> ByteString -> String
P.unpack ByteString
m
               String -> String -> String
</> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> (Char -> Char) -> (Char -> Char) -> Char -> Char
forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
choice (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='.') (Char -> Char -> Char
forall a b. a -> b -> a
const Char
sep) Char -> Char
forall a. a -> a
id) (ByteString -> String
P.unpack ByteString
x)
               String -> String -> String
<.> String
end
    where 
        choice :: m Bool -> m b -> m b -> m b
choice p :: m Bool
p f :: m b
f g :: m b
g = m Bool
p m Bool -> (Bool -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: Bool
b -> if Bool
b then m b
f else m b
g
        x' :: String
x'  = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace String
x'')