    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    module Data.Random.Dice where

    import Data.Random
    import Data.Random.Distribution.Uniform (integralUniform)
    import System.Random.Stateful

    import Control.Monad
    import Control.Monad.Except
    import Data.Functor.Identity
    import Data.Ratio
    import Data.List

    import Text.ParserCombinators.Parsec
    import Text.ParserCombinators.Parsec.Expr
    import Text.ParserCombinators.Parsec.Token
    import Text.ParserCombinators.Parsec.Language
    import Text.Printf

    ----------------------------------------------------------------
    -- A simple expression language

    data Expr a
        = Const   String   a
        | Plus   (Expr a) (Expr a)
        | Minus  (Expr a) (Expr a)
        | Times  (Expr a) (Expr a)
        | Divide (Expr a) (Expr a)
    --    Repeat :: Expr Int -> Expr a -> Expr [a]
        deriving Int -> Expr a -> ShowS
    [Expr a] -> ShowS
    Expr a -> [Char]
    (Int -> Expr a -> ShowS)
    -> (Expr a -> [Char]) -> ([Expr a] -> ShowS) -> Show (Expr a)
    forall a. Show a => Int -> Expr a -> ShowS
    forall a. Show a => [Expr a] -> ShowS
    forall a. Show a => Expr a -> [Char]
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Expr a -> ShowS
    showsPrec :: Int -> Expr a -> ShowS
    $cshow :: forall a. Show a => Expr a -> [Char]
    show :: Expr a -> [Char]
    $cshowList :: forall a. Show a => [Expr a] -> ShowS
    showList :: [Expr a] -> ShowS
    Show

    instance Functor Expr where
        fmap :: forall a b. (a -> b) -> Expr a -> Expr b
    fmap a -> b
    f = ([Char] -> a -> Expr b)
    -> (Expr b -> Expr b -> Expr b)
    -> (Expr b -> Expr b -> Expr b)
    -> (Expr b -> Expr b -> Expr b)
    -> (Expr b -> Expr b -> Expr b)
    -> Expr a
    -> Expr b
    forall {t} {t}.
    ([Char] -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> Expr t
    -> t
    foldExpr (\[Char]
    s a
    x -> [Char] -> b -> Expr b
    forall a. [Char] -> a -> Expr a
    Const [Char]
    s (a -> b
    f a
    x)) Expr b -> Expr b -> Expr b
    forall a. Expr a -> Expr a -> Expr a
    Plus Expr b -> Expr b -> Expr b
    forall a. Expr a -> Expr a -> Expr a
    Minus Expr b -> Expr b -> Expr b
    forall a. Expr a -> Expr a -> Expr a
    Times Expr b -> Expr b -> Expr b
    forall a. Expr a -> Expr a -> Expr a
    Divide

    foldExpr :: ([Char] -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> Expr t
    -> t
    foldExpr [Char] -> t -> t
    c t -> t -> t
    (+) (-) t -> t -> t
    (*) t -> t -> t
    (/) {-(#)-} = Expr t -> t
    fold
        where
            fold :: Expr t -> t
    fold (Const  [Char]
    s t
    a) = [Char] -> t -> t
    c [Char]
    s t
    a
            fold (Plus   Expr t
    x Expr t
    y) = Expr t -> t
    fold Expr t
    x t -> t -> t
    + Expr t -> t
    fold Expr t
    y
            fold (Minus  Expr t
    x Expr t
    y) = Expr t -> t
    fold Expr t
    x t -> t -> t
    - Expr t -> t
    fold Expr t
    y
            fold (Times  Expr t
    x Expr t
    y) = Expr t -> t
    fold Expr t
    x t -> t -> t
    * Expr t -> t
    fold Expr t
    y
            fold (Divide Expr t
    x Expr t
    y) = Expr t -> t
    fold Expr t
    x t -> t -> t
    / Expr t -> t
    fold Expr t
    y
    --        fold (Repeat n y) = undefined # fold y

    evalExprWithDiv :: (Num a, Monad m) => (a -> a -> m a) -> Expr a -> m a
    evalExprWithDiv :: forall a (m :: * -> *).
    (Num a, Monad m) =>
    (a -> a -> m a) -> Expr a -> m a
    evalExprWithDiv a -> a -> m a
    (/) = ([Char] -> a -> m a)
    -> (m a -> m a -> m a)
    -> (m a -> m a -> m a)
    -> (m a -> m a -> m a)
    -> (m a -> m a -> m a)
    -> Expr a
    -> m a
    forall {t} {t}.
    ([Char] -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> Expr t
    -> t
    foldExpr ((a -> m a) -> [Char] -> a -> m a
    forall a b. a -> b -> a
    const a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) ((a -> a -> a) -> m a -> m a -> m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> a
    forall a. Num a => a -> a -> a
    (+)) ((a -> a -> a) -> m a -> m a -> m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (-)) ((a -> a -> a) -> m a -> m a -> m a
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> a
    forall a. Num a => a -> a -> a
    (*)) m a -> m a -> m a
    divM -- (*)
        where
            divM :: m a -> m a -> m a
    divM m a
    x m a
    y = m (m a) -> m a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join ((a -> a -> m a) -> m a -> m a -> m (m a)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 a -> a -> m a
    (/) m a
    x m a
    y)

    evalFractionalExpr :: (Eq a, Fractional a, MonadError String m) => Expr a -> m a
    evalFractionalExpr :: forall a (m :: * -> *).
    (Eq a, Fractional a, MonadError [Char] m) =>
    Expr a -> m a
    evalFractionalExpr = (a -> a -> m a) -> Expr a -> m a
    forall a (m :: * -> *).
    (Num a, Monad m) =>
    (a -> a -> m a) -> Expr a -> m a
    evalExprWithDiv a -> a -> m a
    forall {a} {m :: * -> *}.
    (Eq a, MonadError [Char] m, Fractional a) =>
    a -> a -> m a
    divM
        where
            divM :: a -> a -> m a
    divM a
    x a
    0 = [Char] -> m a
    forall a. [Char] -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "Divide by zero!"
            divM a
    x a
    y = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    x a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    y)

    evalIntegralExpr :: (Integral a, MonadError String m) => Expr a -> m a
    evalIntegralExpr :: forall a (m :: * -> *).
    (Integral a, MonadError [Char] m) =>
    Expr a -> m a
    evalIntegralExpr = (a -> a -> m a) -> Expr a -> m a
    forall a (m :: * -> *).
    (Num a, Monad m) =>
    (a -> a -> m a) -> Expr a -> m a
    evalExprWithDiv a -> a -> m a
    forall {a} {m :: * -> *}.
    (MonadError [Char] m, Integral a) =>
    a -> a -> m a
    divM
        where
            divM :: a -> a -> m a
    divM a
    x a
    0 = [Char] -> m a
    forall a. [Char] -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "Divide by zero!"
            divM a
    x a
    y = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> a -> a
    forall a. Integral a => a -> a -> a
    div a
    x a
    y)

    ----------------------------------------------------------------
    -- Commuting Expr with an arbitrary Monad m

    commute :: (Expr a -> Expr a -> b) -> Expr (m a) -> Expr (m a) -> m b
    commute Expr a -> Expr a -> b
    con Expr (m a)
    x Expr (m a)
    y = do
        Expr a
    x <- Expr (m a) -> m (Expr a)
    forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
    runExpr Expr (m a)
    x
        Expr a
    y <- Expr (m a) -> m (Expr a)
    forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
    runExpr Expr (m a)
    y
        b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr a -> Expr a -> b
    con Expr a
    x Expr a
    y)

    runExpr :: Monad m => Expr (m a) -> m (Expr a)
    runExpr :: forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
    runExpr (Const  [Char]
    s m a
    x) = m a
    x m a -> (a -> m (Expr a)) -> m (Expr a)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Expr a -> m (Expr a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr a -> m (Expr a)) -> (a -> Expr a) -> a -> m (Expr a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> a -> Expr a
    forall a. [Char] -> a -> Expr a
    Const [Char]
    s
    runExpr (Plus   Expr (m a)
    x Expr (m a)
    y) = (Expr a -> Expr a -> Expr a)
    -> Expr (m a) -> Expr (m a) -> m (Expr a)
    forall {m :: * -> *} {a} {a} {b}.
    Monad m =>
    (Expr a -> Expr a -> b) -> Expr (m a) -> Expr (m a) -> m b
    commute Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Plus   Expr (m a)
    x Expr (m a)
    y
    runExpr (Minus  Expr (m a)
    x Expr (m a)
    y) = (Expr a -> Expr a -> Expr a)
    -> Expr (m a) -> Expr (m a) -> m (Expr a)
    forall {m :: * -> *} {a} {a} {b}.
    Monad m =>
    (Expr a -> Expr a -> b) -> Expr (m a) -> Expr (m a) -> m b
    commute Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Minus  Expr (m a)
    x Expr (m a)
    y
    runExpr (Times  Expr (m a)
    x Expr (m a)
    y) = (Expr a -> Expr a -> Expr a)
    -> Expr (m a) -> Expr (m a) -> m (Expr a)
    forall {m :: * -> *} {a} {a} {b}.
    Monad m =>
    (Expr a -> Expr a -> b) -> Expr (m a) -> Expr (m a) -> m b
    commute Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Times  Expr (m a)
    x Expr (m a)
    y
    runExpr (Divide Expr (m a)
    x Expr (m a)
    y) = (Expr a -> Expr a -> Expr a)
    -> Expr (m a) -> Expr (m a) -> m (Expr a)
    forall {m :: * -> *} {a} {a} {b}.
    Monad m =>
    (Expr a -> Expr a -> b) -> Expr (m a) -> Expr (m a) -> m b
    commute Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Divide Expr (m a)
    x Expr (m a)
    y
    -- runExpr (Repeat x y) = commute Repeat x y

    ----------------------------------------------------------------
    -- Pretty-printing 'Expr's

    fmtIntegralExpr :: (Show a, Integral a) => Expr a -> String
    fmtIntegralExpr :: forall a. (Show a, Integral a) => Expr a -> [Char]
    fmtIntegralExpr (Const [Char]
    _ a
    e) = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    e
    fmtIntegralExpr Expr a
    e =
        Bool -> ShowS -> ShowS
    showParen Bool
    True (([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    forall a. ([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec [Char] -> a -> Int -> ShowS
    forall {a} {p}. Show a => [Char] -> a -> p -> ShowS
    showScalarConst Expr a
    e Int
    0)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " => "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT [Char] Identity a -> ShowS
    forall a. Show a => ExceptT [Char] Identity a -> ShowS
    showError (Expr a -> ExceptT [Char] Identity a
    forall a (m :: * -> *).
    (Integral a, MonadError [Char] m) =>
    Expr a -> m a
    evalIntegralExpr Expr a
    e)
        ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ [Char]
    ""

    fmtIntegralListExpr :: (Show a, Integral a) => Expr [a] -> String
    fmtIntegralListExpr :: forall a. (Show a, Integral a) => Expr [a] -> [Char]
    fmtIntegralListExpr (Const [Char]
    _ []) = [Char]
    "0"
    fmtIntegralListExpr (Const [Char]
    _ [a
    e]) = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    e
    fmtIntegralListExpr Expr [a]
    e =
        Bool -> ShowS -> ShowS
    showParen Bool
    True (([Char] -> [a] -> Int -> ShowS) -> Expr [a] -> Int -> ShowS
    forall a. ([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec [Char] -> [a] -> Int -> ShowS
    forall {a} {p}. Show a => [Char] -> a -> p -> ShowS
    showListConst Expr [a]
    e Int
    0)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " => "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT [Char] Identity a -> ShowS
    forall a. Show a => ExceptT [Char] Identity a -> ShowS
    showError (Expr a -> ExceptT [Char] Identity a
    forall a (m :: * -> *).
    (Integral a, MonadError [Char] m) =>
    Expr a -> m a
    evalIntegralExpr (([a] -> a) -> Expr [a] -> Expr a
    forall a b. (a -> b) -> Expr a -> Expr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [a] -> a
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum Expr [a]
    e))
        ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ [Char]
    ""

    fmtSimple :: (Integral a, Show a) => Expr [a] -> String
    fmtSimple :: forall a. (Integral a, Show a) => Expr [a] -> [Char]
    fmtSimple (Const [Char]
    _ []) = [Char]
    "0"
    fmtSimple (Const [Char]
    _ [a
    e]) = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    e
    fmtSimple Expr [a]
    e =
        Bool -> ShowS -> ShowS
    showParen Bool
    False (([Char] -> [a] -> Int -> ShowS) -> Expr [a] -> Int -> ShowS
    forall a. ([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec [Char] -> [a] -> Int -> ShowS
    forall a. Show a => [Char] -> [a] -> Int -> ShowS
    showSimpleListConst Expr [a]
    e Int
    0)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " => "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT [Char] Identity a -> ShowS
    forall a. Show a => ExceptT [Char] Identity a -> ShowS
    showError (Expr a -> ExceptT [Char] Identity a
    forall a (m :: * -> *).
    (Integral a, MonadError [Char] m) =>
    Expr a -> m a
    evalIntegralExpr (([a] -> a) -> Expr [a] -> Expr a
    forall a b. (a -> b) -> Expr a -> Expr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [a] -> a
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum Expr [a]
    e))
        ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ [Char]
    ""

    fmtSimpleRational :: Expr [Integer] -> String
    fmtSimpleRational :: Expr [Integer] -> [Char]
    fmtSimpleRational (Const [Char]
    _ []) = [Char]
    "0"
    fmtSimpleRational (Const [Char]
    _ [Integer
    e]) = Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    e
    fmtSimpleRational Expr [Integer]
    e =
        Bool -> ShowS -> ShowS
    showParen Bool
    False (([Char] -> [Integer] -> Int -> ShowS)
    -> Expr [Integer] -> Int -> ShowS
    forall a. ([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec [Char] -> [Integer] -> Int -> ShowS
    forall a. Show a => [Char] -> [a] -> Int -> ShowS
    showSimpleListConst Expr [Integer]
    e Int
    0)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " => "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ratio Integer -> ShowS)
    -> ExceptT [Char] Identity (Ratio Integer) -> ShowS
    forall {t}. (t -> ShowS) -> ExceptT [Char] Identity t -> ShowS
    showErrorWith Ratio Integer -> ShowS
    showRationalWithDouble (Expr (Ratio Integer) -> ExceptT [Char] Identity (Ratio Integer)
    forall a (m :: * -> *).
    (Eq a, Fractional a, MonadError [Char] m) =>
    Expr a -> m a
    evalFractionalExpr (([Integer] -> Ratio Integer)
    -> Expr [Integer] -> Expr (Ratio Integer)
    forall a b. (a -> b) -> Expr a -> Expr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Ratio Integer
    forall a. Num a => Integer -> a
    fromInteger(Integer -> Ratio Integer)
    -> ([Integer] -> Integer) -> [Integer] -> Ratio Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .[Integer] -> Integer
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum) Expr [Integer]
    e))
        ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ [Char]
    ""

    showScalarConst :: [Char] -> a -> p -> ShowS
    showScalarConst [Char]
    d  a
    v  p
    p = [Char] -> ShowS
    showString [Char]
    d ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    "[" ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    v ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    "]"
    showListConst :: [Char] -> a -> p -> ShowS
    showListConst   [Char]
    d  a
    v  p
    p = [Char] -> ShowS
    showString [Char]
    d ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    v

    showSimpleConst :: (a -> a -> ShowS) -> p -> [a] -> a -> ShowS
    showSimpleConst a -> a -> ShowS
    showsPrec p
    d [a
    v] a
    p = a -> a -> ShowS
    showsPrec a
    p a
    v
    showSimpleConst a -> a -> ShowS
    showsPrec p
    d  [a]
    v  a
    p = Bool -> ShowS -> ShowS
    showParen (a
    p a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0) ((ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) (ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    intersperse (Char -> ShowS
    showChar Char
    '+') ((a -> ShowS) -> [a] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> a -> ShowS
    showsPrec a
    6) [a]
    v)))

    showSimpleListConst :: Show a => String -> [a] -> Int -> ShowS
    showSimpleListConst :: forall a. Show a => [Char] -> [a] -> Int -> ShowS
    showSimpleListConst = (Int -> a -> ShowS) -> [Char] -> [a] -> Int -> ShowS
    forall {a} {a} {p}.
    (Ord a, Num a) =>
    (a -> a -> ShowS) -> p -> [a] -> a -> ShowS
    showSimpleConst Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec

    showSimpleRationalConst :: p -> [Ratio Integer] -> Integer -> ShowS
    showSimpleRationalConst = (Integer -> Ratio Integer -> ShowS)
    -> p -> [Ratio Integer] -> Integer -> ShowS
    forall {a} {a} {p}.
    (Ord a, Num a) =>
    (a -> a -> ShowS) -> p -> [a] -> a -> ShowS
    showSimpleConst Integer -> Ratio Integer -> ShowS
    forall {a} {a}.
    (Show a, Ord a, Num a, Num a, Eq a) =>
    a -> Ratio a -> ShowS
    showRational

    showError :: Show a => ExceptT String Identity a -> ShowS
    showError :: forall a. Show a => ExceptT [Char] Identity a -> ShowS
    showError = (a -> ShowS) -> ExceptT [Char] Identity a -> ShowS
    forall {t}. (t -> ShowS) -> ExceptT [Char] Identity t -> ShowS
    showErrorWith a -> ShowS
    forall a. Show a => a -> ShowS
    shows

    showErrorWith :: (t -> ShowS) -> ExceptT [Char] Identity t -> ShowS
    showErrorWith t -> ShowS
    f (ExceptT (Identity (Left  [Char]
    e))) = [Char] -> ShowS
    showString [Char]
    e
    showErrorWith t -> ShowS
    f (ExceptT (Identity (Right t
    x))) = t -> ShowS
    f t
    x

    showDouble :: Double -> ShowS
    showDouble :: Double -> ShowS
    showDouble Double
    d = [Char] -> ShowS
    showString (ShowS
    trim ([Char] -> Double -> [Char]
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    "%.04g" Double
    d))
        where trim :: ShowS
    trim = ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '0') ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse

    showRational :: a -> Ratio a -> ShowS
    showRational a
    p Ratio a
    d
        | Ratio a -> a
    forall a. Ratio a -> a
    denominator Ratio a
    d a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    1    = a -> ShowS
    forall a. Show a => a -> ShowS
    shows (Ratio a -> a
    forall a. Ratio a -> a
    numerator Ratio a
    d)
        | Bool
    otherwise             = Bool -> ShowS -> ShowS
    showParen (a
    p a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    7)
            ( a -> ShowS
    forall a. Show a => a -> ShowS
    shows (Ratio a -> a
    forall a. Ratio a -> a
    numerator Ratio a
    d)
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '/'
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows (Ratio a -> a
    forall a. Ratio a -> a
    denominator Ratio a
    d)
            )

    showRationalWithDouble :: Ratio Integer -> ShowS
    showRationalWithDouble Ratio Integer
    d
        | Bool
    isInt     = Integer -> Ratio Integer -> ShowS
    forall {a} {a}.
    (Show a, Ord a, Num a, Num a, Eq a) =>
    a -> Ratio a -> ShowS
    showRational Integer
    0 Ratio Integer
    d
        | Bool
    otherwise = Integer -> Ratio Integer -> ShowS
    forall {a} {a}.
    (Show a, Ord a, Num a, Num a, Eq a) =>
    a -> Ratio a -> ShowS
    showRational Integer
    0 Ratio Integer
    d
                    ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " => "
                    ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> ShowS
    showDouble (Ratio Integer -> Double
    forall a. Fractional a => Ratio Integer -> a
    fromRational Ratio Integer
    d)
        where isInt :: Bool
    isInt = Ratio Integer -> Integer
    forall a. Ratio a -> a
    denominator Ratio Integer
    d Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1

    fmtExprPrec :: (String -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec :: forall a. ([Char] -> a -> Int -> ShowS) -> Expr a -> Int -> ShowS
    fmtExprPrec [Char] -> a -> Int -> ShowS
    showConst Expr a
    e = ([Char] -> a -> Int -> ShowS)
    -> ((Int -> ShowS) -> (Int -> ShowS) -> Int -> ShowS)
    -> ((Int -> ShowS) -> (Int -> ShowS) -> Int -> ShowS)
    -> ((Int -> ShowS) -> (Int -> ShowS) -> Int -> ShowS)
    -> ((Int -> ShowS) -> (Int -> ShowS) -> Int -> ShowS)
    -> Expr a
    -> Int
    -> ShowS
    forall {t} {t}.
    ([Char] -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> (t -> t -> t)
    -> Expr t
    -> t
    foldExpr
        (\[Char]
    d a
    v Int
    p -> [Char] -> a -> Int -> ShowS
    showConst [Char]
    d a
    v Int
    p)
        (\Int -> ShowS
    x Int -> ShowS
    y Int
    p -> Bool -> ShowS -> ShowS
    showParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Int
    6) (Int -> ShowS
    x Int
    6 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " + " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    y Int
    6))
        (\Int -> ShowS
    x Int -> ShowS
    y Int
    p -> Bool -> ShowS -> ShowS
    showParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Int
    6) (Int -> ShowS
    x Int
    6 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " - " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    y Int
    7))
        (\Int -> ShowS
    x Int -> ShowS
    y Int
    p -> Bool -> ShowS -> ShowS
    showParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Int
    7) (Int -> ShowS
    x Int
    7 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " * " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    y Int
    7))
        (\Int -> ShowS
    x Int -> ShowS
    y Int
    p -> Bool -> ShowS -> ShowS
    showParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Int
    7) (Int -> ShowS
    x Int
    7 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ShowS
    showString [Char]
    " / " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    y Int
    8))
        Expr a
    e

    ----------------------------------------------------------------
    -- Rolling dice

    rollEm :: String -> IO (Either ParseError String)
    rollEm :: [Char] -> IO (Either ParseError [Char])
    rollEm [Char]
    str = case [Char] -> [Char] -> Either ParseError (Expr (RVar [Integer]))
    forall a.
    (Integral a, UniformRange a) =>
    [Char] -> [Char] -> Either ParseError (Expr (RVar [a]))
    parseExpr [Char]
    "rollEm" [Char]
    str of
        Left ParseError
    err    -> Either ParseError [Char] -> IO (Either ParseError [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseError -> Either ParseError [Char]
    forall a b. a -> Either a b
    Left ParseError
    err)
        Right Expr (RVar [Integer])
    ex    -> do
            Expr [Integer]
    ex <- do
              IOGenM StdGen
    g <- StdGen -> IO (IOGenM StdGen)
    forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
    newIOGenM (StdGen -> IO (IOGenM StdGen)) -> IO StdGen -> IO (IOGenM StdGen)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO StdGen
    forall (m :: * -> *). MonadIO m => m StdGen
    newStdGen
              IOGenM StdGen
    -> RVarT Identity (Expr [Integer]) -> IO (Expr [Integer])
    forall g.
    StatefulGen g IO =>
    g -> RVarT Identity (Expr [Integer]) -> IO (Expr [Integer])
    forall (d :: * -> *) (m :: * -> *) t g.
    (Sampleable d m t, StatefulGen g m) =>
    g -> d t -> m t
    sampleFrom IOGenM StdGen
    g (Expr (RVar [Integer]) -> RVarT Identity (Expr [Integer])
    forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
    runExpr Expr (RVar [Integer])
    ex)
            Either ParseError [Char] -> IO (Either ParseError [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Either ParseError [Char]
    forall a b. b -> Either a b
    Right (Expr [Integer] -> [Char]
    fmtSimpleRational (([Integer] -> [Integer]) -> Expr [Integer] -> Expr [Integer]
    forall a b. (a -> b) -> Expr a -> Expr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> [Integer] -> [Integer]
    forall a. Num a => Int -> [a] -> [a]
    summarizeRollsOver Int
    3) Expr [Integer]
    ex)))
    --        return (Right (fmtIntegralListExpr ex))

    summarizeRollsOver :: Num a => Int -> [a] -> [a]
    summarizeRollsOver :: forall a. Num a => Int -> [a] -> [a]
    summarizeRollsOver Int
    n [a]
    xs
        | [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n [a]
    xs)  = [a]
    xs
        | Bool
    otherwise         = [[a] -> a
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [a]
    xs]

    roll :: (Integral a, UniformRange a) => a -> a -> RVar [a]
    roll :: forall a. (Integral a, UniformRange a) => a -> a -> RVar [a]
    roll a
    count a
    sides
        | a
    count a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    100   = do
            Double
    x <- RVar Double
    forall a. Distribution Normal a => RVar a
    stdNormal :: RVar Double
            let e :: a
    e = a
    counta -> a -> a
    forall a. Num a => a -> a -> a
    *(a
    sidesa -> a -> a
    forall a. Num a => a -> a -> a
    +a
    1)a -> a -> a
    forall a. Integral a => a -> a -> a
    `div`a
    2
                e' :: Double
    e' = a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a
    counta -> a -> a
    forall a. Num a => a -> a -> a
    *(a
    sidesa -> a -> a
    forall a. Num a => a -> a -> a
    +a
    1)a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod`a
    2)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2
                v :: Double
    v = a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a
    sidesa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    sidesa -> a -> a
    forall a. Num a => a -> a -> a
    -a
    1)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    12
                x' :: Double
    x' = Double
    e' Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    sqrt (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    count Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    v)
            [a] -> RVar [a]
    forall a. a -> RVarT Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a
    e a -> a -> a
    forall a. Num a => a -> a -> a
    + Double -> a
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    x']
        | Bool
    otherwise     = do
            [a]
    ls <- Int -> RVarT Identity a -> RVar [a]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    count) (a -> a -> RVarT Identity a
    forall a (m :: * -> *). UniformRange a => a -> a -> RVarT m a
    integralUniform a
    1 a
    sides)
            [a] -> RVar [a]
    forall a. a -> RVarT Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    ls

    ----------------------------------------------------------------
    -- The parser

    parseExpr :: (Integral a, UniformRange a) => String -> String -> Either ParseError (Expr (RVar [a]))
    parseExpr :: forall a.
    (Integral a, UniformRange a) =>
    [Char] -> [Char] -> Either ParseError (Expr (RVar [a]))
    parseExpr [Char]
    src [Char]
    str = GenParser Char Bool (Expr (RVar [a]))
    -> Bool -> [Char] -> [Char] -> Either ParseError (Expr (RVar [a]))
    forall tok st a.
    GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
    runParser GenParser Char Bool (Expr (RVar [a]))
    forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    expr Bool
    False [Char]
    src [Char]
    str

    -- a token-lexer thing
    diceLang :: TokenParser st
    diceLang :: forall st. TokenParser st
    diceLang = GenLanguageDef [Char] st Identity
    -> GenTokenParser [Char] st Identity
    forall s (m :: * -> *) u.
    Stream s m Char =>
    GenLanguageDef s u m -> GenTokenParser s u m
    makeTokenParser
        (GenLanguageDef [Char] st Identity
    forall st. LanguageDef st
    haskellStyle { reservedOpNames :: [[Char]]
    reservedOpNames = [[Char]
    "*",[Char]
    "/",[Char]
    "+",[Char]
    "-"{-,"#"-}] })

    expr :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a]))
    expr :: forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    expr = do
        GenTokenParser [Char] Bool Identity
    -> ParsecT [Char] Bool Identity ()
    forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
    whiteSpace GenTokenParser [Char] Bool Identity
    forall st. TokenParser st
    diceLang
        Expr (RVar [a])
    e <- CharParser Bool (Expr (RVar [a]))
    forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    term
        ParsecT [Char] Bool Identity ()
    forall s (m :: * -> *) t u.
    (Stream s m t, Show t) =>
    ParsecT s u m ()
    eof

        Bool
    hasRolls <- ParsecT [Char] Bool Identity Bool
    forall (m :: * -> *) s u. Monad m => ParsecT s u m u
    getState
        if Bool
    hasRolls
            then Expr (RVar [a]) -> CharParser Bool (Expr (RVar [a]))
    forall a. a -> ParsecT [Char] Bool Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr (RVar [a])
    e
            else [Char] -> CharParser Bool (Expr (RVar [a]))
    forall a. [Char] -> ParsecT [Char] Bool Identity a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "no rolls in expression"

    term :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a]))
    term :: forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    term = OperatorTable Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    forall tok st a.
    OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
    buildExpressionParser OperatorTable Char Bool (Expr (RVar [a]))
    forall {st} {a}. [[Operator Char st (Expr a)]]
    table GenParser Char Bool (Expr (RVar [a]))
    forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    primExp
        where   table :: [[Operator Char st (Expr a)]]
    table =
                    [ [[Char]
    -> (Expr a -> Expr a -> Expr a)
    -> Assoc
    -> Operator Char st (Expr a)
    forall {a} {st}.
    [Char] -> (a -> a -> a) -> Assoc -> Operator Char st a
    binary [Char]
    "*" Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Times Assoc
    AssocLeft, [Char]
    -> (Expr a -> Expr a -> Expr a)
    -> Assoc
    -> Operator Char st (Expr a)
    forall {a} {st}.
    [Char] -> (a -> a -> a) -> Assoc -> Operator Char st a
    binary [Char]
    "/" Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Divide Assoc
    AssocLeft ]
                    , [[Char]
    -> (Expr a -> Expr a -> Expr a)
    -> Assoc
    -> Operator Char st (Expr a)
    forall {a} {st}.
    [Char] -> (a -> a -> a) -> Assoc -> Operator Char st a
    binary [Char]
    "+" Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Plus  Assoc
    AssocLeft, [Char]
    -> (Expr a -> Expr a -> Expr a)
    -> Assoc
    -> Operator Char st (Expr a)
    forall {a} {st}.
    [Char] -> (a -> a -> a) -> Assoc -> Operator Char st a
    binary [Char]
    "-" Expr a -> Expr a -> Expr a
    forall a. Expr a -> Expr a -> Expr a
    Minus  Assoc
    AssocLeft ]
    --                , [binary "#" Repeat AssocRight]
                    ]
                binary :: [Char] -> (a -> a -> a) -> Assoc -> Operator Char st a
    binary [Char]
    name a -> a -> a
    fun Assoc
    assoc = GenParser Char st (a -> a -> a) -> Assoc -> Operator Char st a
    forall tok st a.
    GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
    Infix (do{ GenTokenParser [Char] st Identity
    -> [Char] -> ParsecT [Char] st Identity ()
    forall s u (m :: * -> *).
    GenTokenParser s u m -> [Char] -> ParsecT s u m ()
    reservedOp GenTokenParser [Char] st Identity
    forall st. TokenParser st
    diceLang [Char]
    name; (a -> a -> a) -> GenParser Char st (a -> a -> a)
    forall a. a -> ParsecT [Char] st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a -> a -> a
    fun }) Assoc
    assoc

    primExp :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a]))
    primExp :: forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    primExp = GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    forall tok st a. GenParser tok st a -> GenParser tok st a
    try GenParser Char Bool (Expr (RVar [a]))
    forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    dieExp GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> GenParser Char Bool (Expr (RVar [a]))
    forall a st. Num a => CharParser st (Expr (RVar [a]))
    numExp GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    -> GenParser Char Bool (Expr (RVar [a]))
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> GenTokenParser [Char] Bool Identity
    -> forall a.
       ParsecT [Char] Bool Identity a -> ParsecT [Char] Bool Identity a
    forall s u (m :: * -> *).
    GenTokenParser s u m
    -> forall a. ParsecT s u m a -> ParsecT s u m a
    parens GenTokenParser [Char] Bool Identity
    forall st. TokenParser st
    diceLang GenParser Char Bool (Expr (RVar [a]))
    forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    term

    dieExp :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a]))
    dieExp :: forall a.
    (Integral a, UniformRange a) =>
    CharParser Bool (Expr (RVar [a]))
    dieExp = do
        ([Char]
    cStr, Integer
    count) <- ([Char], Integer)
    -> ParsecT [Char] Bool Identity ([Char], Integer)
    -> ParsecT [Char] Bool Identity ([Char], Integer)
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option ([Char]
    "", Integer
    1) ParsecT [Char] Bool Identity ([Char], Integer)
    forall st. CharParser st ([Char], Integer)
    number
        ([Char]
    sStr, Integer
    sides) <- Char -> ParsecT [Char] Bool Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    'd' ParsecT [Char] Bool Identity Char
    -> ParsecT [Char] Bool Identity ([Char], Integer)
    -> ParsecT [Char] Bool Identity ([Char], Integer)
    forall a b.
    ParsecT [Char] Bool Identity a
    -> ParsecT [Char] Bool Identity b -> ParsecT [Char] Bool Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT [Char] Bool Identity ([Char], Integer)
    forall st. CharParser st ([Char], Integer)
    positiveNumber
        Bool -> ParsecT [Char] Bool Identity ()
    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
    setState Bool
    True
        Expr (RVar [a]) -> CharParser Bool (Expr (RVar [a]))
    forall a. a -> ParsecT [Char] Bool Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> RVar [a] -> Expr (RVar [a])
    forall a. [Char] -> a -> Expr a
    Const ([Char]
    cStr [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    'd' Char -> ShowS
    forall a. a -> [a] -> [a]
    : [Char]
    sStr) (a -> a -> RVar [a]
    forall a. (Integral a, UniformRange a) => a -> a -> RVar [a]
    roll (Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    count) (Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    sides)))

    numExp :: Num a => CharParser st (Expr (RVar [a]))
    numExp :: forall a st. Num a => CharParser st (Expr (RVar [a]))
    numExp = do
        ([Char]
    str, Integer
    num) <- CharParser st ([Char], Integer)
    forall st. CharParser st ([Char], Integer)
    number
        Expr (RVar [a]) -> CharParser st (Expr (RVar [a]))
    forall a. a -> ParsecT [Char] st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> RVar [a] -> Expr (RVar [a])
    forall a. [Char] -> a -> Expr a
    Const [Char]
    str ([a] -> RVar [a]
    forall a. a -> RVarT Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    num]))

    number :: CharParser st (String, Integer)
    number :: forall st. CharParser st ([Char], Integer)
    number = do
        [Char]
    n <- ParsecT [Char] st Identity Char
    -> ParsecT [Char] st Identity [Char]
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT [Char] st Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    digit ParsecT [Char] st Identity [Char]
    -> [Char] -> ParsecT [Char] st Identity [Char]
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> [Char] -> ParsecT s u m a
    <?> [Char]
    "number"
        GenTokenParser [Char] st Identity -> ParsecT [Char] st Identity ()
    forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
    whiteSpace GenTokenParser [Char] st Identity
    forall st. TokenParser st
    diceLang
        ([Char], Integer) -> CharParser st ([Char], Integer)
    forall a. a -> ParsecT [Char] st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    n, [Char] -> Integer
    forall a. Read a => [Char] -> a
    read [Char]
    n)

    positiveNumber :: CharParser st (String, Integer)
    positiveNumber :: forall st. CharParser st ([Char], Integer)
    positiveNumber = do
        ([Char]
    s,Integer
    n) <- CharParser st ([Char], Integer)
    forall st. CharParser st ([Char], Integer)
    number
        Bool -> ParsecT [Char] st Identity ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Integer
    nInteger -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >Integer
    0)
        ([Char], Integer) -> CharParser st ([Char], Integer)
    forall a. a -> ParsecT [Char] st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    s,Integer
    n)