|
@@ -2,15 +2,18 @@
|
|
|
|
|
|
module Types where
|
|
|
|
|
|
+import qualified Control.Exception as Exn
|
|
|
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 }
|
|
|
+type TableName = Text.Text
|
|
|
+type Roll = Int
|
|
|
+
|
|
|
+data Range = Range { rFrom :: Roll, rTo :: Roll }
|
|
|
deriving (Eq, Show)
|
|
|
|
|
|
-type TableMap = Map.Map Text.Text Table
|
|
|
+type TableMap = Map.Map TableName Table
|
|
|
|
|
|
data Table = Table
|
|
|
{ tableName :: Text.Text
|
|
@@ -25,12 +28,43 @@ data Fragment
|
|
|
data Result = Result { fromResult :: [Fragment] }
|
|
|
deriving (Eq, Show)
|
|
|
|
|
|
+-- * Values
|
|
|
+
|
|
|
data Value = Value
|
|
|
- { valueMsg :: Text.Text
|
|
|
+ { valueMsg :: Text.Text
|
|
|
+ , valueFrom :: TableName
|
|
|
+ , valueResult :: Roll
|
|
|
+ , valueSources :: [Value]
|
|
|
} deriving (Eq, Show)
|
|
|
|
|
|
+concatValues :: Context -> [Value] -> Value
|
|
|
+concatValues _ [v] = v
|
|
|
+concatValues Context { ctxSelf = table, ctxRoll = roll } vs = Value
|
|
|
+ { valueMsg = foldMap valueMsg vs
|
|
|
+ , valueFrom = table
|
|
|
+ , valueResult = roll
|
|
|
+ , valueSources = vs
|
|
|
+ }
|
|
|
+
|
|
|
+bareValue :: Context -> Text.Text -> Value
|
|
|
+bareValue Context { ctxSelf = table, ctxRoll = roll } text = Value
|
|
|
+ { valueMsg = text
|
|
|
+ , valueFrom = table
|
|
|
+ , valueResult = roll
|
|
|
+ , valueSources = []
|
|
|
+ }
|
|
|
+
|
|
|
stripValue :: Value -> Value
|
|
|
-stripValue = Value . Text.strip . valueMsg
|
|
|
+stripValue value = value { valueMsg = Text.strip (valueMsg value) }
|
|
|
+
|
|
|
+-- * Exceptions
|
|
|
+
|
|
|
+data NoSuchTable = NoSuchTable Text.Text
|
|
|
+ deriving (Eq, Show)
|
|
|
+
|
|
|
+instance Exn.Exception NoSuchTable where
|
|
|
+
|
|
|
+-- * Context
|
|
|
|
|
|
data Context = Context
|
|
|
{ ctxMap :: TableMap
|
|
@@ -38,23 +72,25 @@ data Context = Context
|
|
|
, ctxSelf :: Text.Text
|
|
|
}
|
|
|
|
|
|
+-- * Evaluating Tables
|
|
|
+
|
|
|
findTable :: Text.Text -> Context -> Maybe Table
|
|
|
findTable name ctx = Map.lookup name (ctxMap ctx)
|
|
|
|
|
|
computeFragments :: Context -> Fragment -> IO Value
|
|
|
-computeFragments _ (FragText msg) = pure (Value msg)
|
|
|
+computeFragments ctx (FragText msg) = pure (bareValue ctx msg)
|
|
|
computeFragments ctx (FragRoll name) =
|
|
|
let absolute = case Text.stripPrefix "self" name of
|
|
|
Just rest -> ctxSelf ctx <> rest
|
|
|
Nothing -> name
|
|
|
in case findTable absolute ctx of
|
|
|
Just t -> rollTable (ctxMap ctx) t
|
|
|
- Nothing -> error ("no such table: " ++ show absolute)
|
|
|
+ Nothing -> Exn.throwIO (NoSuchTable absolute)
|
|
|
|
|
|
computeResult :: Context -> Result -> IO Value
|
|
|
computeResult ctx (Result msgs) = do
|
|
|
vs <- mapM (computeFragments ctx) msgs
|
|
|
- pure (Value (foldMap valueMsg vs))
|
|
|
+ pure (concatValues ctx vs)
|
|
|
|
|
|
tableDie :: Table -> Int
|
|
|
tableDie t = maximum [ x | (Range _ x, _) <- tableChoices t ]
|