{-# 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 ()