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

import Control.Monad            (replicateM)
import Control.Monad.Trans      (liftIO)
import Data.ByteString          (ByteString)
import Data.ByteString.Char8    (pack)
import Data.Monoid              ((<>))
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 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 "dice"
       LogLevel -> ByteString -> ParsecT ByteString () m ()
forall (m :: * -> *). BotMonad m => LogLevel -> ByteString -> m ()
logM LogLevel
Debug "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
       (numDice :: Integer
numDice, numSides :: Integer
numSides, modifier :: 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 1
         if Integer
nd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 100
            then String -> ParsecT ByteString () m (Integer, Integer, Integer)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "You can not roll more than 100 dice."
            else do
              Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m 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
> 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 "The dice must have at least 1 side"
                    )
              Integer
mod <- (do Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m 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 0
              (Integer, Integer, Integer)
-> ParsecT ByteString () m (Integer, Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
nd, Integer
ns, Integer
mod)) 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
<?> "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. Random a => (a, a) -> IO a
randomRIO (1, Integer
numSides)
       let results :: String
results = "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
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
numSides String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-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]
++ " 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
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 ()