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