Handle ambiguity in table creation

src/Main.hs

@@ -4,6 +4,7 @@
 
 module Main where
 
+import qualified Control.Exception as Exn
 import qualified Control.Monad as M
 import qualified Data.IORef as IO
 import qualified Data.Map.Strict as Map
@@ -66,9 +67,16 @@ main = do
           Nothing -> do
             Text.putStrLn ("table not found: " <> Text.pack (show choice))
             Text.putStrLn ("  valid tables include: " <> names)
-          Just t -> do
-            v <- Types.rollTable tables t
-            showValueAndRolls v
+          Just t ->
+            (Types.rollTable tables t >>= showValueAndRolls)
+              `Exn.catch` handleBadTable
+
+handleBadTable :: Types.BadTable -> IO ()
+handleBadTable bt = do
+  let msg = Text.intercalate "\n" (Types.potreroMessage bt)
+  Text.putStr "\x1b[91m"
+  Text.putStr msg
+  Text.putStrLn "\x1b[39m"
 
 -- | simply show the value generated
 showValue :: Types.Value -> IO ()

src/Types.hs

@@ -14,10 +14,40 @@ type Roll = Int
 data Range = Range { rFrom :: Roll, rTo :: Roll }
   deriving (Eq, Show)
 
+class Exn.Exception t => PotreroError t where
+  potreroMessage :: t -> [Text.Text]
+
+data BadTable = BadTable
+  { badTableTable :: Table
+  , badTableIndex :: [Int]
+  } deriving (Eq, Show)
+
+instance Exn.Exception BadTable where
+
+instance PotreroError BadTable where
+  potreroMessage bt =
+    let rolls = map (Text.pack . show) (badTableIndex bt)
+        results = [ "`" <> Text.strip (showResult r) <> "`"
+                  | (Range x y, r) <- tableChoices (badTableTable bt)
+                  , or [ i >= x && i <= y | i <- badTableIndex bt]
+                  ]
+        orText = Text.intercalate " or "
+    in [ "Malformed table: `" <> tableName (badTableTable bt) <> "`"
+       , "  a roll of " <> orText rolls <> " is ambiguous"
+       , "  and may result in either " <> orText results
+       ]
+
 -- needed to handle d66 tables
-rangeMap :: [Range] -> [Int]
-rangeMap = Set.toList . foldr (Set.union . toSet) Set.empty
-  where toSet (Range x y) = Set.fromList [x..y]
+rangeMap :: Table -> [(Range, Result)] -> [Int]
+rangeMap t ranges = Set.toList (go Set.empty ranges)
+  where
+    go set [] = set
+    go set ((Range x y, _result):rs) =
+      let rangeSet = Set.fromList [x..y]
+          overlap = Set.intersection rangeSet set
+      in if Set.null overlap
+         then go (Set.union rangeSet set) rs
+         else Exn.throw (BadTable t (Set.toList overlap))
 
 type TableMap = Map.Map TableName Table
 
@@ -34,6 +64,11 @@ data Fragment
 data Result = Result { fromResult ::  [Fragment] }
     deriving (Eq, Show)
 
+showResult :: Result -> Text.Text
+showResult = foldMap go . fromResult
+  where go (FragText t) = t
+        go (FragRoll n) = "@{" <> n <> "}"
+
 -- * Values
 
 data Value = Value
@@ -100,7 +135,7 @@ computeResult ctx (Result msgs) = do
 
 rollTable :: TableMap -> Table -> IO Value
 rollTable tables t = do
-  let rmap = rangeMap (map fst (tableChoices t))
+  let rmap = rangeMap t (tableChoices t)
   rollIdx <- Rand.randomRIO (0, length rmap - 1)
   let roll = rmap !! rollIdx
       ctx = Context
@@ -113,11 +148,4 @@ rollTable tables t = do
        , roll >= rFrom range && roll <= rTo range
        ] of
     [choice] -> stripValue <$> computeResult ctx choice
-    [] -> error $ unwords
-          [ "bad table "
-          , Text.unpack (tableName t)
-          , "(roll of"
-          , show roll
-          , "has no matching result)"
-          ]
-    _ -> error "ambiguous result (TODO)"
+    _ -> error "unreachable"