dice 0.1.0.1 → 0.1.1

raw patch · 2 files changed

+45/−44 lines, 2 filesdep +mtldep +randomdep −transformersdep ~random-funew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl, random

Dependencies removed: transformers

Dependency ranges changed: random-fu

API changes (from Hackage documentation)

Files

• dice.cabal +16/−11
• src/Data/Random/Dice.hs +29/−33

@@ -1,35 +1,40 @@+cabal-version:          3.0 name:                   dice-version:                0.1.0.1+version:                0.1.1 stability:              work-in-progress -cabal-version:          >= 1.6 build-type:             Simple  author:                 James Cook <mokus@deepbondi.net>-maintainer:             Bertram Felgenhauer <int-e@gmx.de>-license:                PublicDomain+maintainer:             Naïm Favier <n@monade.li>+license:                Unlicense  category:               Game synopsis:               Simplistic D&D style dice-rolling system. description:            Simplistic D&D style dice-rolling system.-                        .+                         > $ dice "2d10 + 2 * (d100 / d6)"                         > (5+2) + 2 * 64 / 2 => 71 -bug-reports:            https://github.com/lambdabot/dice/issues+bug-reports:            https://github.com/ncfavier/dice/issues  extra-source-files:   CHANGELOG  source-repository head   type: git-  location: git://github.com/lambdabot/dice.git+  location: git://github.com/ncfavier/dice.git -Library+common common   hs-source-dirs:       src+  build-depends:        base >= 3 && < 5, random >= 1.2, random-fu >= 0.3, parsec, mtl+  default-language:     Haskell2010++library+  import:               common   exposed-modules:      Data.Random.Dice-  build-depends:        base >= 3 && < 5, random-fu, parsec, transformers -Executable dice-  hs-source-dirs:       src+executable dice+  import:               common+  other-modules:        Data.Random.Dice   main-is:              Dice.hs

@@ -1,11 +1,13 @@ {-# 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.Trans.Error+import Control.Monad.Except import Data.Functor.Identity import Data.Ratio import Data.List@@ -32,7 +34,7 @@     fmap f = foldExpr (\s x -> Const s (f x)) Plus Minus Times Divide  foldExpr c (+) (-) (*) (/) {-(#)-} = fold-    where +    where         fold (Const  s a) = c s a         fold (Plus   x y) = fold x + fold y         fold (Minus  x y) = fold x - fold y@@ -45,24 +47,16 @@     where         divM x y = join (liftM2 (/) x y) -#if __GLASGOW_HASKELL__ < 808-evalFractionalExpr :: (Eq a, Fractional a, Monad m) => Expr a -> m a-#else-evalFractionalExpr :: (Eq a, Fractional a, MonadFail m) => Expr a -> m a-#endif+evalFractionalExpr :: (Eq a, Fractional a, MonadError String m) => Expr a -> m a evalFractionalExpr = evalExprWithDiv divM     where-        divM x 0 = fail "Divide by zero!"+        divM x 0 = throwError "Divide by zero!"         divM x y = return (x / y) -#if __GLASGOW_HASKELL__ < 808-evalIntegralExpr :: (Integral a, Monad m) => Expr a -> m a-#else-evalIntegralExpr :: (Integral a, MonadFail m) => Expr a -> m a-#endif+evalIntegralExpr :: (Integral a, MonadError String m) => Expr a -> m a evalIntegralExpr = evalExprWithDiv divM     where-        divM x 0 = fail "Divide by zero!"+        divM x 0 = throwError "Divide by zero!"         divM x y = return (div x y)  ----------------------------------------------------------------@@ -86,7 +80,7 @@  fmtIntegralExpr :: (Show a, Integral a) => Expr a -> String fmtIntegralExpr (Const _ e) = show e-fmtIntegralExpr e = +fmtIntegralExpr e =     showParen True (fmtExprPrec showScalarConst e 0)     . showString " => "     . showError (evalIntegralExpr e)@@ -95,7 +89,7 @@ fmtIntegralListExpr :: (Show a, Integral a) => Expr [a] -> String fmtIntegralListExpr (Const _ []) = "0" fmtIntegralListExpr (Const _ [e]) = show e-fmtIntegralListExpr e = +fmtIntegralListExpr e =     showParen True (fmtExprPrec showListConst e 0)     . showString " => "     . showError (evalIntegralExpr (fmap sum e))@@ -104,7 +98,7 @@ fmtSimple :: (Integral a, Show a) => Expr [a] -> String fmtSimple (Const _ []) = "0" fmtSimple (Const _ [e]) = show e-fmtSimple e = +fmtSimple e =     showParen False (fmtExprPrec showSimpleListConst e 0)     . showString " => "     . showError (evalIntegralExpr (fmap sum e))@@ -130,11 +124,11 @@  showSimpleRationalConst = showSimpleConst showRational -showError :: Show a => ErrorT String Identity a -> ShowS+showError :: Show a => ExceptT String Identity a -> ShowS showError = showErrorWith shows -showErrorWith f (ErrorT (Identity (Left  e))) = showString e-showErrorWith f (ErrorT (Identity (Right x))) = f x+showErrorWith f (ExceptT (Identity (Left  e))) = showString e+showErrorWith f (ExceptT (Identity (Right x))) = f x  showDouble :: Double -> ShowS showDouble d = showString (trim (printf "%.04g" d))@@ -143,12 +137,12 @@ showRational p d     | denominator d == 1    = shows (numerator d)     | otherwise             = showParen (p > 7)-        ( shows (numerator d) +        ( shows (numerator d)         . showChar '/'         . shows (denominator d)         ) -showRationalWithDouble d +showRationalWithDouble d     | isInt     = showRational 0 d     | otherwise = showRational 0 d                 . showString " => "@@ -171,7 +165,9 @@ rollEm str = case parseExpr "rollEm" str of     Left err    -> return (Left err)     Right ex    -> do-        ex <- sample $ runExpr ex :: IO (Expr [Integer])+        ex <- do+          g <- newIOGenM =<< newStdGen+          sampleFrom g (runExpr ex)         return (Right (fmtSimpleRational (fmap (summarizeRollsOver 3) ex))) --        return (Right (fmtIntegralListExpr ex)) @@ -180,7 +176,7 @@     | null (drop n xs)  = xs     | otherwise         = [sum xs] -roll :: (Integral a) => a -> a -> RVar [a]+roll :: (Integral a, UniformRange a) => a -> a -> RVar [a] roll count sides     | count > 100   = do         x <- stdNormal :: RVar Double@@ -196,38 +192,38 @@ ---------------------------------------------------------------- -- The parser -parseExpr :: (Integral a) => String -> String -> Either ParseError (Expr (RVar [a]))+parseExpr :: (Integral a, UniformRange a) => String -> String -> Either ParseError (Expr (RVar [a])) parseExpr src str = runParser expr False src str  -- a token-lexer thing diceLang :: TokenParser st-diceLang = makeTokenParser +diceLang = makeTokenParser     (haskellStyle { reservedOpNames = ["*","/","+","-"{-,"#"-}] }) -expr :: (Integral a) => CharParser Bool (Expr (RVar [a]))+expr :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a])) expr = do     whiteSpace diceLang     e <- term     eof-    +     hasRolls <- getState     if hasRolls         then return e         else fail "no rolls in expression" -term :: (Integral a) => CharParser Bool (Expr (RVar [a]))+term :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a])) term = buildExpressionParser table primExp     where   table =-                [ [binary "*" Times AssocLeft, binary "/" Divide AssocLeft ] +                [ [binary "*" Times AssocLeft, binary "/" Divide AssocLeft ]                 , [binary "+" Plus  AssocLeft, binary "-" Minus  AssocLeft ] --                , [binary "#" Repeat AssocRight]                 ]             binary name fun assoc = Infix (do{ reservedOp diceLang name; return fun }) assoc -primExp :: (Integral a) => CharParser Bool (Expr (RVar [a]))+primExp :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a])) primExp = try dieExp <|> numExp <|> parens diceLang term -dieExp :: (Integral a) => CharParser Bool (Expr (RVar [a]))+dieExp :: (Integral a, UniformRange a) => CharParser Bool (Expr (RVar [a])) dieExp = do     (cStr, count) <- option ("", 1) number     (sStr, sides) <- char 'd' >> positiveNumber@@ -235,7 +231,7 @@     return (Const (cStr ++ 'd' : sStr) (roll (fromInteger count) (fromInteger sides)))  numExp :: Num a => CharParser st (Expr (RVar [a]))-numExp = do +numExp = do     (str, num) <- number     return (Const str (return [fromInteger num]))