praxis

Various programming exercises.
git clone git://git.jtobin.io/praxis.git
Log | Files | Refs

Roller.hs (1892B)

      1 {-# OPTIONS_GHC -Wall #-}
      2 {-# LANGUAGE LambdaCase #-}
      3 {-# LANGUAGE OverloadedStrings #-}
      4 {-# LANGUAGE RecordWildCards #-}
      5 {-# LANGUAGE ViewPatterns #-}
      6 
      7 import Control.Monad (replicateM)
      8 import qualified Data.Char as C (digitToInt, isDigit)
      9 import qualified Data.List as L (foldl', unfoldr)
     10 import Data.Monoid ((<>))
     11 import qualified Data.Random as R
     12 import qualified Data.Text as T
     13 import qualified Data.Text.IO as TIO
     14 import qualified Data.Foldable as F (for_)
     15 
     16 data Roll = Roll {
     17     ndie :: !Int
     18   , nsid :: !Int
     19   } deriving Show
     20 
     21 newtype Rolls = Rolls {
     22     rolls :: [Int]
     23   } deriving Show
     24 
     25 parseLine :: T.Text -> Maybe Roll
     26 parseLine (T.strip -> input) = case T.splitOn "d" input of
     27   [nd, ns] -> do
     28     ndie <- parseInt nd
     29     nsid <- parseInt ns
     30 
     31     if   (ndie > 0 && ndie < 101) && (nsid > 1 && nsid < 101)
     32     then return Roll {..}
     33     else Nothing
     34 
     35   _        -> Nothing
     36 
     37 parseInt :: T.Text -> Maybe Int
     38 parseInt input
     39     | T.any (not . C.isDigit) input = Nothing
     40     | otherwise                     = Just parsed
     41   where
     42     lints        = T.foldl' alg [] input
     43     alg acc char = C.digitToInt char : acc
     44 
     45     ptens   = L.unfoldr coalg (0 :: Int)
     46     coalg j = Just (10 ^ j, succ j)
     47 
     48     parsed = L.foldl' (+) 0 (zipWith (*) lints ptens)
     49 
     50 eval :: Roll -> IO Rolls
     51 eval Roll {..} = do
     52   rolls <- replicateM ndie (R.sample (R.uniform 1 nsid))
     53   return Rolls {..}
     54 
     55 render :: Show a => a -> T.Text
     56 render = T.pack . show
     57 
     58 present :: Rolls -> T.Text
     59 present Rolls {..} = render (sum rolls) <> " -- " <> render rolls
     60 
     61 main :: IO ()
     62 main = do
     63   input <- TIO.getContents
     64 
     65   let feed = T.lines input
     66       rs   = fmap parseLine feed
     67 
     68   F.for_ rs $ \result ->
     69     case result of
     70       Nothing -> do
     71         TIO.putStrLn "usage: ./roll MdN"
     72         TIO.putStrLn "(M in 1 -- 100, N in 2 -- 100)"
     73 
     74       Just roll -> do
     75         results <- eval roll
     76         TIO.putStrLn (present results)
     77