-- | 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 String
"eval")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"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 String
"choose")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"choose. Lambdabot featuring AI power"
            , process :: String -> Cmd (ModuleT () LB) ()
process = \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 String
"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
            }
          | (String
cmd, String -> String
op) <- [(String, String -> String)]
dummylst
          ]
    }

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

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

lookupWiki :: String -> String
lookupWiki :: String -> String
lookupWiki String
page = String
"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 (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'_' else Char
c)

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

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

lookupGoogle :: String -> String
lookupGoogle :: String -> String
lookupGoogle String
"" = String
googlePrefix
lookupGoogle String
xs = String
googlePrefix String -> 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 (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'+' else Char
x)

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

lookupPackage :: String -> Char -> String -> String -> String
lookupPackage :: String -> Char -> String -> String -> String
lookupPackage String
begin Char
sep String
end 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
        Maybe (ByteString, ByteString)
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]
++ String
" not available"
        Just (ByteString
x, 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 -> 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 m Bool
p m b
f 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
>>= \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'')