-- | This module is for throwing dice for e.g. RPGs. (\@dice 3d6+2)

-- Original version copyright Einar Karttunen <ekarttun@cs.helsinki.fi> 2005-04-06.
-- Massive rewrite circa 2008-10-20 copyright James Cook <mokus@deepbondi.net>
module Lambdabot.Plugin.Novelty.Dice (dicePlugin) where

import Lambdabot.Plugin
import Lambdabot.Util

import Data.List
import Data.Random.Dice (rollEm)

type Dice = ModuleT () LB

dicePlugin :: Module ()
dicePlugin :: Module ()
dicePlugin = 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
        [ (String -> Command Identity
command String
"dice")
            { aliases :: [String]
aliases = [String
"roll"]
            , help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@dice <expr>. Throw random dice. <expr> is of the form 3d6+2."
            , process :: String -> Cmd (ModuleT () LB) ()
process = Bool -> String -> Cmd (ModuleT () LB) ()
doDice Bool
True
            }
        ]
    , contextual :: String -> Cmd (ModuleT () LB) ()
contextual = Bool -> String -> Cmd (ModuleT () LB) ()
doDice Bool
False
    }

doDice :: Bool -> String -> Cmd Dice ()
doDice :: Bool -> String -> Cmd (ModuleT () LB) ()
doDice Bool
printErrs String
text = do
    String
user <- Nick -> Cmd (ModuleT () LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (Nick -> Cmd (ModuleT () LB) String)
-> Cmd (ModuleT () LB) Nick -> Cmd (ModuleT () LB) String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT () LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    Either ParseError String
result <- IO (Either ParseError String)
-> Cmd (ModuleT () LB) (Either ParseError String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO (Either ParseError String)
rollEm String
text)
    case Either ParseError String
result of
        Left ParseError
err    -> if Bool
printErrs
            then String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (ParseError -> String
trimError ParseError
err)
            else () -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Right String
str   -> 
            String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (Int -> String -> String
limitStr Int
75 (String
user String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str))
    
    where
        trimError :: ParseError -> String
trimError = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (ParseError -> [String]) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
": " ([String] -> [String])
-> (ParseError -> [String]) -> ParseError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String])
-> (ParseError -> [String]) -> ParseError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (ParseError -> String) -> ParseError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show