{-# LANGUAGE OverloadedStrings #-}
module Network.IRC.Bot.Part.Dice where

import Control.Monad            (replicateM, void)
import Control.Monad.Trans      (liftIO)
import Data.ByteString          (ByteString)
import Data.ByteString.Char8    (pack)
import Network.IRC.Bot.Log      (LogLevel(Debug))
import Network.IRC.Bot.BotMonad (BotMonad(..), maybeZero)
import Network.IRC.Bot.Commands (PrivMsg(..), sendCommand, replyTo)
import Network.IRC.Bot.Parsec   (botPrefix, nat, parsecPart)
import System.Random            (randomRIO)
import Text.Parsec              (ParsecT, (<|>), (<?>), char, skipMany1, space, string, try)

dicePart :: (BotMonad m) => m ()
dicePart :: m ()
dicePart = ParsecT ByteString () m () -> m ()
forall (m :: * -> *) a.
BotMonad m =>
ParsecT ByteString () m a -> m a
parsecPart ParsecT ByteString () m ()
forall (m :: * -> *). BotMonad m => ParsecT ByteString () m ()
diceCommand

diceCommand :: (BotMonad m) => ParsecT ByteString () m ()
diceCommand :: ParsecT ByteString () m ()
diceCommand =
    do ParsecT ByteString () m String -> ParsecT ByteString () m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ByteString () m String -> ParsecT ByteString () m ())
-> ParsecT ByteString () m String -> ParsecT ByteString () m ()
forall a b. (a -> b) -> a -> b
$ ParsecT ByteString () m String -> ParsecT ByteString () m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT ByteString () m String -> ParsecT ByteString () m String)
-> ParsecT ByteString () m String -> ParsecT ByteString () m String
forall a b. (a -> b) -> a -> b
$ ParsecT ByteString () m ()
forall (m :: * -> *). BotMonad m => ParsecT ByteString () m ()
botPrefix ParsecT ByteString () m ()
-> ParsecT ByteString () m String -> ParsecT ByteString () m String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT ByteString () m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"dice"
       LogLevel -> ByteString -> ParsecT ByteString () m ()
forall (m :: * -> *). BotMonad m => LogLevel -> ByteString -> m ()
logM LogLevel
Debug ByteString
"dicePart"
       ByteString
target <- Maybe ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
maybeZero (Maybe ByteString -> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m (Maybe ByteString)
-> ParsecT ByteString () m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT ByteString () m (Maybe ByteString)
forall (m :: * -> *). BotMonad m => m (Maybe ByteString)
replyTo
       (Integer
numDice, Integer
numSides, Integer
modifier) <- (do
         ParsecT ByteString () m Char -> ParsecT ByteString () m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
         Integer
nd <- ParsecT ByteString () m Integer
forall (m :: * -> *). Monad m => ParsecT ByteString () m Integer
nat ParsecT ByteString () m Integer
-> ParsecT ByteString () m Integer
-> ParsecT ByteString () m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT ByteString () m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1
         if Integer
nd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
100
            then String -> ParsecT ByteString () m (Integer, Integer, Integer)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You can not roll more than 100 dice."
            else do
              Char
_ <- Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd'
              Integer
ns <- (do Integer
n <- ParsecT ByteString () m Integer
forall (m :: * -> *). Monad m => ParsecT ByteString () m Integer
nat
                        if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
                         then Integer -> ParsecT ByteString () m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
                         else String -> ParsecT ByteString () m Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The dice must have at least 1 side"
                    )
              Integer
modifier <- (do Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT ByteString () m Char
-> ParsecT ByteString () m Integer
-> ParsecT ByteString () m Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT ByteString () m Integer
forall (m :: * -> *). Monad m => ParsecT ByteString () m Integer
nat) ParsecT ByteString () m Integer
-> ParsecT ByteString () m Integer
-> ParsecT ByteString () m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT ByteString () m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
              (Integer, Integer, Integer)
-> ParsecT ByteString () m (Integer, Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
nd, Integer
ns, Integer
modifier)) ParsecT ByteString () m (Integer, Integer, Integer)
-> String -> ParsecT ByteString () m (Integer, Integer, Integer)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dice <num-dice>d<num-sides>[+<modifier>]"
       [Integer]
rolls <- IO [Integer] -> ParsecT ByteString () m [Integer]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Integer] -> ParsecT ByteString () m [Integer])
-> IO [Integer] -> ParsecT ByteString () m [Integer]
forall a b. (a -> b) -> a -> b
$ Int -> IO Integer -> IO [Integer]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
numDice) (IO Integer -> IO [Integer]) -> IO Integer -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> IO Integer
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Integer
1, Integer
numSides)
       let results :: String
results = String
"You rolled " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
numDice String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
numSides String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sided dice with a +" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
modifier String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" modifier: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Integer] -> String
forall a. Show a => a -> String
show [Integer]
rolls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" => " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Integer
modifier Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
rolls))
       PrivMsg -> ParsecT ByteString () m ()
forall c (m :: * -> *).
(ToMessage c, BotMonad m, Functor m) =>
c -> m ()
sendCommand (Maybe Prefix -> [ByteString] -> ByteString -> PrivMsg
PrivMsg Maybe Prefix
forall a. Maybe a
Nothing [ByteString
target] (String -> ByteString
pack String
results))
    ParsecT ByteString () m ()
-> ParsecT ByteString () m () -> ParsecT ByteString () m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> ParsecT ByteString () m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()