potrero/src/Types.hs

{-# LANGUAGE OverloadedStrings #-}

module Types where

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified System.Random as Rand

data Range = Range { rFrom :: Int, rTo :: Int }
  deriving (Eq, Show)

type TableMap = Map.Map Text.Text Table

data Table = Table
  { tableName :: Text.Text
  , tableChoices :: [(Range, Result)]
  } deriving (Eq, Show)

data Result
  = ResultText Text.Text
  | ResultRoll Text.Text
    deriving (Eq, Show)

computeResult :: Int -> TableMap -> Result -> IO ()
computeResult r _  (ResultText msg) = do
  Text.putStr ("\x1b[36m" <> Text.pack (show r) <> ":\x1b[39m ")
  Text.putStrLn msg
computeResult r ts (ResultRoll name)
  | Just t <- Map.lookup name ts = do
      Text.putStr ("\x1b[36m" <> Text.pack (show r))
      Text.putStrLn (": (roll " <> name <> ")\x1b[39m")
      rollTable ts t
  | otherwise = Text.putStrLn ("error: no such table: " <> name)

tableDie :: Table -> Int
tableDie t = maximum [ x | (Range _ x, _) <- tableChoices t ]

rollTable :: TableMap -> Table -> IO ()
rollTable tables t = do
  roll <- Rand.randomRIO (1, tableDie t)
  case [ result
       | (range, result) <- tableChoices t
       , roll >= rFrom range && roll <= rTo range
       ] of
    [choice] -> computeResult roll tables choice
    _ -> Text.putStrLn $ Text.unwords
           [ "bad table "
           , tableName t
           , "(roll of"
           , Text.pack (show roll)
           , "has no matching result)"
           ]