Bind protocol evidence to the TLA+ model

test/ModelEvidenceMain.hs

@@ -0,0 +1,59 @@
+module Main (main) where
+
+import           Data.Aeson (eitherDecodeFileStrict)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import           Nuthatch.ModelEvidence
+import           System.Environment (getArgs)
+import           System.Exit (die)
+
+main :: IO ()
+main = do
+  arguments <- getArgs
+  case arguments of
+    ["inventory"] -> printInventory
+    ["verify", fixturePath] -> verifyFixtures fixturePath
+    _ -> die "usage: nuthatch-model-evidence inventory | verify FIXTURES"
+
+printInventory :: IO ()
+printInventory = do
+  mapM_
+    (\action ->
+      printFields ["ACTION", actionConstructor action, actionName action])
+    allModelActions
+  mapM_
+    (\check ->
+      printFields ["CHECK", checkConstructor check, checkName check])
+    allModelChecks
+  mapM_
+    (\ScenarioEvidence{..} ->
+      printFields
+        [ "SCENARIO"
+        , actionConstructor scenarioAction
+        , actionName scenarioAction
+        , scenarioPrecondition
+        , scenarioObservation
+        , scenarioExpectedPost
+        ])
+    scenarioEvidence
+
+verifyFixtures :: FilePath -> IO ()
+verifyFixtures fixturePath = do
+  decoded <- eitherDecodeFileStrict fixturePath
+  fixtures <-
+    either
+      (die . ("cannot decode projection fixtures: " <>))
+      pure
+      decoded
+  projected <-
+    either
+      (die . T.unpack)
+      pure
+      (verifySnapshotFixtures fixtures)
+  mapM_
+    (\ProjectedFixture{..} ->
+      printFields ["SNAPSHOT", projectedName, projectedPhase])
+    projected
+
+printFields :: [T.Text] -> IO ()
+printFields = T.putStrLn . T.intercalate "\t"