gdritter repos potrero / master
Handle ambiguity in table creation Getty Ritter 5 years ago
2 changed file(s) with 51 addition(s) and 15 deletion(s). Collapse all Expand all
+11
-3
src/Main.hs less more
44
55 module Main where
66
7 import qualified Control.Exception as Exn
78 import qualified Control.Monad as M
89 import qualified Data.IORef as IO
910 import qualified Data.Map.Strict as Map
6667 Nothing -> do
6768 Text.putStrLn ("table not found: " <> Text.pack (show choice))
6869 Text.putStrLn (" valid tables include: " <> names)
69 Just t -> do
70 v <- Types.rollTable tables t
71 showValueAndRolls v
70 Just t ->
71 (Types.rollTable tables t >>= showValueAndRolls)
72 `Exn.catch` handleBadTable
73
74 handleBadTable :: Types.BadTable -> IO ()
75 handleBadTable bt = do
76 let msg = Text.intercalate "\n" (Types.potreroMessage bt)
77 Text.putStr "\x1b[91m"
78 Text.putStr msg
79 Text.putStrLn "\x1b[39m"
7280
7381 -- | simply show the value generated
7482 showValue :: Types.Value -> IO ()
+40
-12
src/Types.hs less more
1414 data Range = Range { rFrom :: Roll, rTo :: Roll }
1515 deriving (Eq, Show)
1616
17 class Exn.Exception t => PotreroError t where
18 potreroMessage :: t -> [Text.Text]
19
20 data BadTable = BadTable
21 { badTableTable :: Table
22 , badTableIndex :: [Int]
23 } deriving (Eq, Show)
24
25 instance Exn.Exception BadTable where
26
27 instance PotreroError BadTable where
28 potreroMessage bt =
29 let rolls = map (Text.pack . show) (badTableIndex bt)
30 results = [ "`" <> Text.strip (showResult r) <> "`"
31 | (Range x y, r) <- tableChoices (badTableTable bt)
32 , or [ i >= x && i <= y | i <- badTableIndex bt]
33 ]
34 orText = Text.intercalate " or "
35 in [ "Malformed table: `" <> tableName (badTableTable bt) <> "`"
36 , " a roll of " <> orText rolls <> " is ambiguous"
37 , " and may result in either " <> orText results
38 ]
39
1740 -- needed to handle d66 tables
18 rangeMap :: [Range] -> [Int]
19 rangeMap = Set.toList . foldr (Set.union . toSet) Set.empty
20 where toSet (Range x y) = Set.fromList [x..y]
41 rangeMap :: Table -> [(Range, Result)] -> [Int]
42 rangeMap t ranges = Set.toList (go Set.empty ranges)
43 where
44 go set [] = set
45 go set ((Range x y, _result):rs) =
46 let rangeSet = Set.fromList [x..y]
47 overlap = Set.intersection rangeSet set
48 in if Set.null overlap
49 then go (Set.union rangeSet set) rs
50 else Exn.throw (BadTable t (Set.toList overlap))
2151
2252 type TableMap = Map.Map TableName Table
2353
3363
3464 data Result = Result { fromResult :: [Fragment] }
3565 deriving (Eq, Show)
66
67 showResult :: Result -> Text.Text
68 showResult = foldMap go . fromResult
69 where go (FragText t) = t
70 go (FragRoll n) = "@{" <> n <> "}"
3671
3772 -- * Values
3873
100135
101136 rollTable :: TableMap -> Table -> IO Value
102137 rollTable tables t = do
103 let rmap = rangeMap (map fst (tableChoices t))
138 let rmap = rangeMap t (tableChoices t)
104139 rollIdx <- Rand.randomRIO (0, length rmap - 1)
105140 let roll = rmap !! rollIdx
106141 ctx = Context
113148 , roll >= rFrom range && roll <= rTo range
114149 ] of
115150 [choice] -> stripValue <$> computeResult ctx choice
116 [] -> error $ unwords
117 [ "bad table "
118 , Text.unpack (tableName t)
119 , "(roll of"
120 , show roll
121 , "has no matching result)"
122 ]
123 _ -> error "ambiguous result (TODO)"
151 _ -> error "unreachable"