diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright 2018 Viktor Tanyi + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,35 @@ +# hedra + +As in polyhedra. Generates dice rolls in the REPL or in a standalone executable. + +Example REPL session: + +``` +$ cabal v2-repl +λ> 2 `d` 8 +8 | 1 7 +λ> 1 `d` 20 +13 +λ> 1 `d` 100 +25 | 20 5 +λ> 4 `d` f +3 | [ ] [+] [+] [+] +``` + +Example session in the executable: + +``` +$ cabal v2-run hedra +hedra> 2d8 +2d8: 14 | 6 8 +hedra> 1d20 +1d20: 1 +hedra> d20 +d20: 5 +hedra> d100 +d100: 61 | 60 1 +hedra> d% +d%: 5 | 00 5 +hedra> 4df +4df: 2 | [ ] [+] [+] [ ] +``` diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE LambdaCase #-} + +module Main (main) where + +import qualified Hedra +import qualified System.Console.Haskeline as Haskeline + +import Control.Applicative ((<|>)) +import Control.Monad (guard, when) +import Control.Monad.IO.Class (liftIO) +import Data.Char (isDigit, isSpace) +import Data.List (dropWhileEnd) +import Data.Maybe (listToMaybe) + +main :: IO () +main = + Haskeline.runInputT settings loop + where + settings :: Haskeline.Settings IO + settings = Haskeline.setComplete Haskeline.noCompletion Haskeline.defaultSettings + + loop :: Haskeline.InputT IO () + loop = do + lineMay <- Haskeline.getInputLine "hedra> " + case lineMay of + Just line -> do + let trimmedLine = (dropWhile isSpace . dropWhileEnd isSpace) line + when + (not (null trimmedLine)) + (liftIO (processInput trimmedLine)) + loop + Nothing -> + pure () + + processInput :: String -> IO () + processInput input = + case parseInput input of + Just (count, die) -> do + putStr (input ++ ": ") + Hedra.printRoll count die + Nothing -> + putStrLn "Invalid input. Valid formats: d4, 2d6, 1d100, 1d%, 4df" + +parseInput :: String -> Maybe (Int, Hedra.Die) +parseInput input = + listToMaybe $ do + (count, afterCount) <- reads input <|> [(1, input)] + guard (count >= 0) + (_, afterSeparator) <- parseSeparator afterCount + (die, _) <- parseDie afterSeparator + pure (count, die) + +parseSeparator :: String -> [((), String)] +parseSeparator = \case + 'd' : rest -> [((), rest)] + _ -> [] + +parseDie :: String -> [(Hedra.Die, String)] +parseDie = \case + "%" -> [(Hedra.Percentile, "")] + "f" -> [(Hedra.Fudge, "")] + digits@(_:_) | all isDigit digits -> + case read digits of + 0 -> [] + positiveSides -> [(fromIntegral (positiveSides :: Int), "")] + _ -> [] diff --git a/hedra.cabal b/hedra.cabal new file mode 100644 --- /dev/null +++ b/hedra.cabal @@ -0,0 +1,83 @@ +cabal-version: >=1.10 +name: hedra +version: 0.1 +synopsis: A small library and executable for generating dice rolls. +homepage: https://github.com/vtan/hedra +license: MIT +license-file: LICENSE +author: Viktor Tanyi +maintainer: tanyi.viktor@gmail.com +category: Game +build-type: Simple +extra-source-files: README.md +tested-with: + GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.3 + +description: + As in polyhedra. Generates dice rolls in the REPL or in a standalone executable. + . + Example REPL session: + . + > $ cabal v2-repl + > λ> 2 `d` 8 + > 8 | 1 7 + > λ> 1 `d` 20 + > 13 + > λ> 1 `d` 100 + > 25 | 20 5 + > λ> 4 `d` f + > 3 | [ ] [+] [+] [+] + . + Example session in the executable: + . + > $ cabal v2-run hedra + > hedra> 2d8 + > 2d8: 14 | 6 8 + > hedra> 1d20 + > 1d20: 1 + > hedra> d20 + > d20: 5 + > hedra> d100 + > d100: 61 | 60 1 + > hedra> d% + > d%: 5 | 00 5 + > hedra> 4df + > 4df: 2 | [ ] [+] [+] [ ] + +source-repository head + type: git + location: https://github.com/vtan/hedra.git + +library + hs-source-dirs: src + exposed-modules: Hedra + build-depends: + base >=4.10 && <4.13, + random >=1.1 + ghc-options: -O2 -Wall + other-extensions: InstanceSigs + default-language: Haskell2010 + +executable hedra + hs-source-dirs: app + main-is: Main.hs + build-depends: + hedra + , base >=4.10 && <4.13 + , haskeline >=0.7.4.3 && <0.8 + ghc-options: -O2 -Wall + other-extensions: LambdaCase + default-language: Haskell2010 + +test-suite doctests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Doctests.hs + build-depends: + hedra + , base >=4.10 && <4.13 + , doctest >=0.9.2 + ghc-options: -Wall + default-language: Haskell2010 diff --git a/src/Hedra.hs b/src/Hedra.hs new file mode 100644 --- /dev/null +++ b/src/Hedra.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE InstanceSigs #-} + +-- | Generating dice rolls. +-- The functions in this module use the global random generator +-- described in "System.Random#globalrng". + +module Hedra + ( Die(..) + , d, f + , roll, showRoll, printRoll + ) +where + +import Control.Monad (replicateM) +import Data.List (intercalate) +import System.Random (randomRIO) + +-- $setup +-- >>> import System.Random (mkStdGen, setStdGen) +-- >>> setStdGen (mkStdGen 0) + +-- | Variants of dice. +data Die + -- | A die with the given number of sides. The number is assumed to be positive. + = Sides Int + -- | Two 10-sided dice, one for tens and one for ones. Two zeros are interpreted as 100. + | Percentile + -- | A die with the values -1, 0 and +1. + | Fudge + +-- | Only for using 'Num' literals as 'Die' values, all other methods throw an error. +-- The literal @100@ corresponds to percentile dice, +-- all other literals are dice with that many sides. +instance Num Die where + fromInteger :: Integer -> Die + fromInteger n = + case n of + 100 -> Percentile + _ -> Sides (fromInteger n) + + (+) = error "Num instance for Die not implemented" + (-) = error "Num instance for Die not implemented" + (*) = error "Num instance for Die not implemented" + abs = error "Num instance for Die not implemented" + signum = error "Num instance for Die not implemented" + +-- | An alias of 'printRoll' to be used in the REPL. +-- +-- >>> 2 `d` 8 +-- 10 | 4 6 +-- >>> 1 `d` 20 +-- 4 +d :: Int -> Die -> IO () +d = printRoll + +-- | An alias of 'Fudge' to be used in the REPL. +-- +-- >>> 4 `d` f +-- 0 | [+] [+] [-] [-] +f :: Die +f = Fudge + +-- | Generates a dice roll as a list of individual rolls. +-- +-- >>> roll 2 8 +-- [4,6] +-- >>> roll 1 20 +-- [4] +-- >>> roll 1 Percentile +-- [39] +-- >>> roll 4 Fudge +-- [0,0,-1,0] +roll + :: Int -- ^ The number of dice to roll, must be at least 0. + -> Die -- ^ The variant of dice to roll. + -> IO [Int] -- ^ The list of individual die rolls. +roll count die + | count < 0 = error "Must roll at least zero dice." + | otherwise = replicateM count oneRoll + where + oneRoll :: IO Int + oneRoll = case die of + Sides sides | sides < 1 -> error "Dice must have at least one side." + Sides sides -> randomRIO (1, sides) + Percentile -> randomRIO (1, 100) + Fudge -> randomRIO ((-1), 1) + +-- | Generates a dice roll as a string. +-- +-- >>> showRoll 2 8 +-- "10 | 4 6" +-- >>> showRoll 1 20 +-- "4" +-- >>> showRoll 1 Percentile +-- "39 | 30 9" +-- >>> showRoll 4 Fudge +-- "-1 | [ ] [ ] [-] [ ]" +showRoll + :: Int -- ^ The number of dice to roll, must be at least 0. + -> Die -- ^ The variant of dice to roll. + -> IO String -- ^ The pretty-printed dice roll. +showRoll count die = do + rolls <- roll count die + let rollSum = sum rolls + rollStrings = map showOneRoll rolls + showSum = case die of + Percentile -> True + _ -> count > 1 + str = + (if showSum then show rollSum ++ " | " else "") + ++ intercalate " " rollStrings + pure str + where + showOneRoll :: Int -> String + showOneRoll n = + case die of + Sides _ -> + show n + Percentile -> + case n `divMod` 10 of + (10, 0) -> "00 0" + (0, ones) -> unwords ["00", show ones] + (tens, ones) -> unwords [show (tens * 10), show ones] + Fudge -> + case n of + -1 -> "[-]" + 0 -> "[ ]" + 1 -> "[+]" + _ -> error ("Fudge die result out of range: " ++ show n) + +-- | Generates and prints and a dice roll. +-- +-- >>> printRoll 2 8 +-- 10 | 4 6 +-- >>> printRoll 1 20 +-- 4 +-- >>> printRoll 1 Percentile +-- 39 | 30 9 +-- >>> printRoll 4 Fudge +-- -1 | [ ] [ ] [-] [ ] +printRoll + :: Int -- ^ The number of dice to roll, must be at least 0. + -> Die -- ^ The variant of dice to roll. + -> IO () +printRoll count die = + showRoll count die >>= putStrLn diff --git a/test/Doctests.hs b/test/Doctests.hs new file mode 100644 --- /dev/null +++ b/test/Doctests.hs @@ -0,0 +1,6 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest ["-isrc", "src/Hedra.hs"]