Check script output in damlc integration tests (#17380)

* Refactor damlc integration test input into datatype

* Factor out 'withLog' helper function

* Reduce scope of 'service' in 'testCase'

* Use 'testPassed' helper for ignored test files

* Reduce scope of 'TestCase' and 'log' in 'testCase'

* Use guards instead of nested if-then-else in 'testCase'

* Extract 'testSetup' from 'testCase' using 'withResource'

* {testCase=>damlFileTestTree} now produces a test tree

* Split jq queries into individual tests

* whitespace

* Add ledger expectation tests

* Avoid double inversion-of-control

.hlint.yaml

@@ -122,6 +122,7 @@
     - DA.Daml.Desugar.Tests
     - DA.Daml.Doc.Tests
     - DA.Test.DamlRenamer
+    - DA.Test.DamlcIntegration
     - DA.Signals
     - Development.IDE.Core.Compile
     - Development.IDE.GHC.Compat

compiler/damlc/tests/BUILD.bazel

@@ -109,10 +109,14 @@ da_haskell_test(
 da_haskell_library(
     name = "integration-lib",
     srcs = ["src/DA/Test/DamlcIntegration.hs"],
+    compiler_flags = [
+        "-DPOSIX_DIFF=\"$(POSIX_DIFF)\"",
+    ],
     hackage_deps = [
         "aeson-pretty",
         "base",
         "bytestring",
+        "containers",
         "data-default",
         "deepseq",
         "directory",
@@ -129,10 +133,15 @@ da_haskell_library(
         "shake",
         "tagged",
         "tasty",
+        "tasty-golden",
         "tasty-hunit",
         "text",
         "time",
         "unordered-containers",
+        "vector",
+    ],
+    toolchains = [
+        "@rules_sh//sh/posix:make_variables",
     ],
     visibility = ["//visibility:public"],
     deps = [
@@ -146,6 +155,7 @@ da_haskell_library(
         "//compiler/damlc/daml-opts",
         "//compiler/damlc/daml-opts:daml-opts-types",
         "//compiler/damlc/daml-package-config",
+        "//compiler/damlc/daml-rule-types",
         "//compiler/scenario-service/client",
         "//daml-assistant:daml-project-config",
         "//daml-lf/archive:daml_lf_dev_archive_haskell_proto",

compiler/damlc/tests/daml-test-files/LedgerTestException.EXPECTED.ledger

@@ -0,0 +1,8 @@
+Script execution failed:
+  Unhandled exception:  DA.Exception.GeneralError:GeneralError with
+                          message = "ohno"
+
+Ledger time: 1970-01-01T00:00:00Z
+
+Trace: 
+  hello world

compiler/damlc/tests/daml-test-files/LedgerTestException.daml

@@ -0,0 +1,13 @@
+-- Copyright (c) 2023, Digital Asset (Switzerland) GmbH and/or its affiliates.
+-- All rights reserved.
+
+module LedgerTestException where
+
+import Daml.Script
+
+-- @ERROR ohno
+-- @LEDGER test LedgerTestException.EXPECTED.ledger
+test : Script (Int, Bool)
+test = do
+  debugRaw "hello world"
+  error "ohno"

compiler/damlc/tests/daml-test-files/LedgerTestOk.EXPECTED.ledger

@@ -0,0 +1,22 @@
+Transactions: 
+  TX 0 1970-01-01T00:00:00Z (LedgerTestOk:23:5)
+  #0:0
+  │   referenced by #1:0
+  │   disclosed to (since): 'alice' (0)
+  └─> 'alice' creates LedgerTestOk:T
+              with
+                p = 'alice'
+  
+  TX 1 1970-01-01T00:00:00Z (LedgerTestOk:27:5)
+  #1:0
+  │   disclosed to (since): 'alice' (1)
+  └─> 'alice' exercises Noop on #0:0 (LedgerTestOk:T)
+
+Active contracts:  #0:0
+
+Return value:
+  DA.Types:Tuple2 with
+    _1 = 42; _2 = false
+
+Trace: 
+  hello world

compiler/damlc/tests/daml-test-files/LedgerTestOk.daml

@@ -0,0 +1,29 @@
+-- Copyright (c) 2023, Digital Asset (Switzerland) GmbH and/or its affiliates.
+-- All rights reserved.
+
+module LedgerTestOk where
+
+import Daml.Script
+
+template T
+  with
+    p : Party
+  where
+    signatory p
+    nonconsuming choice Noop : ()
+      controller p
+      do pure ()
+
+-- @LEDGER test LedgerTestOk.EXPECTED.ledger
+test : Script (Int, Bool)
+test = do
+  debugRaw "hello world"
+  alice <- allocateParty "alice"
+  cid <-
+    alice `submit`
+      createCmd T with
+        p = alice
+  () <-
+    alice `submit`
+      exerciseCmd cid Noop
+  pure (42, False)

compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs

@@ -1,6 +1,9 @@
 -- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE CPP #-}
+
 -- | Test driver for Daml-GHC CompilerService.
 -- For each file, compile it with GHC, convert it,
 -- typecheck with LF, test it.  Test annotations are documented as 'Ann'.
@@ -26,6 +29,7 @@ import           Control.DeepSeq
 import           Control.Exception.Extra
 import           Control.Monad
 import           Control.Monad.IO.Class
+import           DA.Daml.LF.PrettyScenario (prettyScenarioError, prettyScenarioResult)
 import           DA.Daml.LF.Proto3.EncodeV1
 import qualified DA.Daml.LF.Proto3.Archive.Encode as Archive
 import           DA.Pretty hiding (first)
@@ -58,11 +62,16 @@ import           System.IO
 import           System.IO.Extra
 import           System.Info.Extra (isWindows)
 import           Text.Read
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.HashSet as HashSet
+import qualified Data.Set as S
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Vector as V
 import           System.Time.Extra
 import Development.IDE.Core.API
 import Development.IDE.Core.Rules.Daml
+import Development.IDE.Core.RuleTypes.Daml (VirtualResource (..))
 import qualified Development.IDE.Types.Diagnostics as D
 import Development.IDE.GHC.Util
 import           Data.Tagged                  (Tagged (..))
@@ -72,12 +81,12 @@ import Outputable (ppr, showSDoc)
 import qualified Proto3.Suite.JSONPB as JSONPB
 
 import Test.Tasty
+import Test.Tasty.Golden (goldenVsStringDiff)
 import qualified Test.Tasty.HUnit as HUnit
 import Test.Tasty.HUnit ((@?=))
 import Test.Tasty.Options
 import Test.Tasty.Providers
-import Test.Tasty.Providers.ConsoleFormat (noResultDetails)
-import Test.Tasty.Runners (Outcome(..), Result(..))
+import Test.Tasty.Runners (Result(..))
 
 import DA.Daml.Package.Config (PackageSdkVersion (..))
 import DA.Cli.Damlc.DependencyDb (installDependencies)
@@ -134,7 +143,7 @@ type ScriptPackageData = (FilePath, [PackageFlag])
 -- | Creates a temp directory with daml script v1 installed, gives the database db path and package flag
 withDamlScriptDep :: Maybe Version -> (ScriptPackageData -> IO a) -> IO a
 withDamlScriptDep mLfVer =
-  let 
+  let
     lfVerStr = maybe "" (\lfVer -> "-" <> renderVersion lfVer) mLfVer
     darPath = "daml-script" </> "daml" </> "daml-script" <> lfVerStr <> ".dar"
   in withVersionedDamlScriptDep ("daml-script-" <> sdkPackageVersion) darPath mLfVer []
@@ -145,7 +154,7 @@ withDamlScriptV2Dep =
     darPath = "daml-script" </> "daml3" </> "daml3-script.dar"
   in withVersionedDamlScriptDep
        ("daml3-script-" <> sdkPackageVersion)
-       darPath 
+       darPath
        (Just version2_dev) -- daml-script only supports 2.dev for now
        scriptV2ExternalPackages
 
@@ -256,29 +265,51 @@ uniqueUniques = HUnit.testCase "Uniques" $
         let n = length $ nubOrd $ concat results
         n @?= 10000
 
-getDamlTestFiles :: FilePath -> IO [(String, FilePath, [Ann])]
+data DamlTestInput = DamlTestInput
+  { name :: String
+  , path :: FilePath
+  , anns :: [Ann]
+  }
+
+getDamlTestFiles :: FilePath -> IO [DamlTestInput]
 getDamlTestFiles location = do
     -- test files are declared as data in BUILD.bazel
     testsLocation <- locateRunfiles $ mainWorkspace </> location
     files <- filter (".daml" `isExtensionOf`) <$> listFiles testsLocation
     forM files $ \file -> do
         anns <- readFileAnns file
-        pure (makeRelative testsLocation file, file, anns)
+        pure DamlTestInput
+            { name = makeRelative testsLocation file
+            , path = file
+            , anns
+            }
 
-getBondTradingTestFiles :: IO [(String, FilePath, [Ann])]
+getBondTradingTestFiles :: IO [DamlTestInput]
 getBondTradingTestFiles = do
     -- only run Test.daml (see https://github.com/digital-asset/daml/issues/726)
     bondTradingLocation <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/bond-trading"
     let file = bondTradingLocation </> "Test.daml"
     anns <- readFileAnns file
-    pure [("bond-trading/Test.daml", file, anns)]
+    pure
+        [ DamlTestInput
+            { name = "bond-trading/Test.daml"
+            , path = file
+            , anns
+            }
+        ]
 
-getCantSkipPreprocessorTestFiles :: IO [(String, FilePath, [Ann])]
+getCantSkipPreprocessorTestFiles :: IO [DamlTestInput]
 getCantSkipPreprocessorTestFiles = do
     cantSkipPreprocessorLocation <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/cant-skip-preprocessor"
     let file = cantSkipPreprocessorLocation </> "DA" </> "Internal" </> "Hack.daml"
     anns <- readFileAnns file
-    pure [("cant-skip-preprocessor/DA/Internal/Hack.daml", file, anns)]
+    pure
+        [ DamlTestInput
+            { name = "cant-skip-preprocessor/DA/Internal/Hack.daml"
+            , path = file
+            , anns
+            }
+        ]
 
 getIntegrationTests :: (TODO -> IO ()) -> SS.Handle -> ScriptPackageData -> IO TestTree
 getIntegrationTests registerTODO scenarioService (packageDbPath, packageFlags) = do
@@ -286,7 +317,7 @@ getIntegrationTests registerTODO scenarioService (packageDbPath, packageFlags) =
     do n <- getNumCapabilities; putStrLn $ "getNumCapabilities: " ++ show n
 
     damlTests <-
-        mconcat @(IO [(String, FilePath, [Ann])])
+        mconcat @(IO [DamlTestInput])
             [ getDamlTestFiles "compiler/damlc/tests/daml-test-files"
             , getBondTradingTestFiles
             , getCantSkipPreprocessorTestFiles
@@ -331,7 +362,7 @@ getIntegrationTests registerTODO scenarioService (packageDbPath, packageFlags) =
             shutdown
             $ \service ->
           testGroup ("Tests for Daml-LF " ++ renderPretty version) $
-            map (testCase version isScriptV2Opt evalOrder service outdir registerTODO) damlTests
+            map (damlFileTestTree version isScriptV2Opt evalOrder service outdir registerTODO) damlTests
 
     pure tree
 
@@ -339,43 +370,98 @@ newtype TestCase = TestCase ((String -> IO ()) -> IO Result)
 
 instance IsTest TestCase where
   run _ (TestCase r) _ = do
-    logger <- newIORef DList.empty
-    let log msg = modifyIORef logger (`DList.snoc` msg)
-    res <- r log
-    msgs <- readIORef logger
-    let desc
-          | null (resultDescription res) = unlines (DList.toList msgs)
-          | otherwise = unlines (DList.toList (msgs `DList.snoc` resultDescription res))
-    pure $ res { resultDescription = desc }
+    (res, log) <- withLog \log -> do
+      res <- r log
+      log (resultDescription res)
+      pure res
+    pure res { resultDescription = log }
   testOptions = Tagged []
 
-testCase :: LF.Version -> IsScriptV2Opt -> EvaluationOrder -> IO IdeState -> FilePath -> (TODO -> IO ()) -> (String, FilePath, [Ann]) -> TestTree
-testCase version (IsScriptV2Opt isScriptV2Opt) evalOrderOpt getService outdir registerTODO (name, file, anns) = singleTest name . TestCase $ \log -> do
+-- | 'withLog' takes a function 'f :: (String -> IO ()) -> IO a'
+-- (that is, a function such that given a logger function ':: String -> IO ()'
+-- returns (in an IO context) a value of type 'a'), so that 'withLog f' is an
+-- IO action that performs all the actions of 'f' and returns the
+-- final value of type 'a' together with the final log.
+withLog :: ((String -> IO ()) -> IO a) -> IO (a, String)
+withLog action = do
+  logger <- newIORef DList.empty
+  let log msg = unless (null msg) $ modifyIORef logger (`DList.snoc` msg)
+  r <- action log
+  msgs <- readIORef logger
+  pure (r, unlines (DList.toList msgs))
+
+data DamlOutput = DamlOutput
+  { diagnostics :: [D.FileDiagnostic]
+  , jsonPackagePath :: Maybe FilePath
+  , buildLog :: String
+  , scriptResults :: HashMap.HashMap T.Text T.Text
+  }
+
+testSetup :: IO IdeState -> FilePath -> FilePath -> IO DamlOutput
+testSetup getService outdir path = do
   service <- getService
-  if any (`notElem` supportedOutputVersions) [v | UntilLF v <- anns] then
-    pure (testFailed "Unsupported Daml-LF version in UNTIL-LF annotation")
-  else if any (ignoreVersion version) anns
-    then pure $ Result
-      { resultOutcome = Success
-      , resultDescription = ""
-      , resultShortDescription = "IGNORE"
-      , resultTime = 0
-      , resultDetailsPrinter = noResultDetails
-      }
-    else do
-      -- FIXME: Use of unsafeClearDiagnostics is only because we don't naturally lose them when we change setFilesOfInterest
-      unsafeClearDiagnostics service
-      ex <- try $ mainProj service outdir log (toNormalizedFilePath' file) :: IO (Either SomeException (Package, FilePath))
-      diags <- getDiagnostics service
-      for_ [file ++ ", " ++ x | Todo x <- anns] (registerTODO . TODO)
-      resDiag <- checkDiagnostics log [fields | DiagnosticFields fields <- anns] $
-        [ideErrorText "" $ T.pack $ show e | Left e <- [ex], not $ "_IGNORE_" `isInfixOf` show e] ++ diags
-      resQueries <- runJqQuery log (eitherToMaybe $ snd <$> ex) [(q, isStream) | QueryLF q isStream <- anns]
-      let failures = catMaybes $ resDiag : resQueries
-      case failures of
-        err : _others -> pure $ testFailed err
-        [] -> pure $ testPassed ""
+  (ex, buildLog) <- withLog \log ->
+    try @SomeException $ mainProj service outdir log (toNormalizedFilePath' path)
+  diags0 <- getDiagnostics service
+  pure DamlOutput
+    { diagnostics =
+        [ ideErrorText "" $ T.pack $ show e
+        | Left e <- [ex]
+        , not $ "_IGNORE_" `isInfixOf` show e
+        ] ++ diags0
+    , jsonPackagePath = (\(_, x, _) -> x) <$> eitherToMaybe ex
+    , scriptResults = either (const HashMap.empty) (\(_, _, x) -> x) ex
+    , buildLog
+    }
+
+damlFileTestTree :: LF.Version -> IsScriptV2Opt -> EvaluationOrder -> IO IdeState -> FilePath -> (TODO -> IO ()) -> DamlTestInput -> TestTree
+damlFileTestTree version (IsScriptV2Opt isScriptV2Opt) evalOrderOpt getService outdir registerTODO input
+  | any (`notElem` supportedOutputVersions) [v | UntilLF v <- anns] =
+    singleTest name $ TestCase \_ ->
+      pure $ testFailed "Unsupported Daml-LF version in UNTIL-LF annotation"
+  | any (ignoreVersion version) anns =
+    singleTest name $ TestCase \_ ->
+      pure (testPassed "") { resultShortDescription = "IGNORE" }
+  | otherwise =
+    withResource
+      (testSetup getService outdir path)
+      (\_ ->
+        -- FIXME: Use of unsafeClearDiagnostics is only because we don't naturally lose them when we change setFilesOfInterest
+        getService >>= unsafeClearDiagnostics
+      )
+      \getDamlOutput -> do
+        testGroup name
+          [ singleTest "Build log" $ TestCase \_ -> do
+              for_ [path ++ ", " ++ x | Todo x <- anns] (registerTODO . TODO)
+              testPassed . buildLog <$> getDamlOutput
+          , singleTest "Check diagnostics" $ TestCase \log -> do
+              diags <- diagnostics <$> getDamlOutput
+              resDiag <- checkDiagnostics log [fields | DiagnosticFields fields <- anns] diags
+              pure $ maybe (testPassed "") testFailed resDiag
+          , testGroup "jq Queries"
+              [ singleTest ("#" <> show @Integer ix) $ TestCase \log -> do
+                  mJsonFile <- jsonPackagePath <$> getDamlOutput
+                  r <- runJqQuery log mJsonFile q isStream
+                  pure $ maybe (testPassed "") testFailed r
+              | (ix, QueryLF q isStream) <- zip [1..] anns
+              ]
+          , testGroup "Ledger expectation tests"
+              [ goldenVsStringDiff
+                  ("Script: " <> scriptName <> ", file: " <> expectedFile)
+                  diff
+                  (takeDirectory path </> expectedFile)
+                  do
+                    scriptResult <-
+                      fromMaybe (error $ "Ledger expectation test failure: the script '" <> scriptName <> "' did not run")
+                      . HashMap.lookup (T.pack scriptName)
+                      . scriptResults
+                      <$> getDamlOutput
+                    pure $ BSL.fromStrict $ TE.encodeUtf8 scriptResult
+              | Ledger scriptName expectedFile <- anns
+              ]
+          ]
   where
+    DamlTestInput { name, path, anns } = input
     ignoreVersion version = \case
       Ignore -> True
       SinceLF minVersion -> version < minVersion
@@ -383,25 +469,24 @@ testCase version (IsScriptV2Opt isScriptV2Opt) evalOrderOpt getService outdir re
       ScriptV2 -> not isScriptV2Opt
       EvaluationOrder evalOrder -> evalOrder /= evalOrderOpt
       _ -> False
+    diff ref new = [POSIX_DIFF, "--strip-trailing-cr", ref, new]
 
-runJqQuery :: (String -> IO ()) -> Maybe FilePath -> [(String, Bool)] -> IO [Maybe String]
-runJqQuery log mJsonFile qs = do
+runJqQuery :: (String -> IO ()) -> Maybe FilePath -> String -> Bool -> IO (Maybe String)
+runJqQuery log mJsonFile q isStream = do
   case mJsonFile of
-    Just jsonPath ->
-      forM qs $ \(q, isStream) -> do
-        log $ "running jq query: " ++ q
-        let jqKey = "external" </> "jq_dev_env" </> "bin" </> if isWindows then "jq.exe" else "jq"
-        jq <- locateRunfiles $ mainWorkspace </> jqKey
-        queryLfDir <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/src"
-        let fullQuery = "import \"./query-lf\" as lf; inputs as $pkg | " ++ q
-        out <- readProcess jq (["--stream" | isStream] <> ["-n", "-L", queryLfDir, fullQuery, jsonPath]) ""
-        case trim out of
-          "true" -> pure Nothing
-          other -> pure $ Just $ "jq query failed: got " ++ other
-    _ | not $ null qs -> do
-      log $ "jq query failed: " ++ show (length qs) ++ " queries failed to run as test errored"
-      pure [Just "Couldn't run jq"]
-    _ -> pure []
+    Just jsonPath -> do
+      log $ "running jq query: " ++ q
+      let jqKey = "external" </> "jq_dev_env" </> "bin" </> if isWindows then "jq.exe" else "jq"
+      jq <- locateRunfiles $ mainWorkspace </> jqKey
+      queryLfDir <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/src"
+      let fullQuery = "import \"./query-lf\" as lf; inputs as $pkg | " ++ q
+      out <- readProcess jq (["--stream" | isStream] <> ["-n", "-L", queryLfDir, fullQuery, jsonPath]) ""
+      case trim out of
+        "true" -> pure Nothing
+        other -> pure $ Just $ "jq query failed: got " ++ other
+    _ | otherwise -> do
+      log "jq query failed to run as test errored"
+      pure (Just "Couldn't run jq")
 
 data DiagnosticField
   = DFilePath !FilePath
@@ -456,14 +541,25 @@ checkDiagnostics log expected got
 ------------------------------------------------------------
 -- functionality
 data Ann
-    = Ignore                             -- Don't run this test at all
-    | SinceLF LF.Version                 -- Only run this test since the given Daml-LF version (inclusive)
-    | UntilLF LF.Version                 -- Only run this test until the given Daml-LF version (exclusive)
-    | DiagnosticFields [DiagnosticField] -- I expect a diagnostic that has the given fields
-    | QueryLF String Bool                -- The jq query against the produced Daml-LF returns "true". Includes a boolean for is stream
-    | ScriptV2                           -- Run only in daml script V2
-    | Todo String                        -- Just a note that is printed out
+    = Ignore
+      -- ^ Don't run this test at all
+    | SinceLF LF.Version
+      -- ^ Only run this test since the given Daml-LF version (inclusive)
+    | UntilLF LF.Version
+      -- ^ Only run this test until the given Daml-LF version (exclusive)
+    | DiagnosticFields [DiagnosticField]
+      -- ^ I expect a diagnostic that has the given fields
+    | QueryLF String Bool
+      -- ^ The jq query against the produced Daml-LF returns "true". Includes a boolean for is stream
+    | ScriptV2
+      -- ^ Run only in daml script V2
+    | Todo String
+      -- ^ Just a note that is printed out
+    | Ledger String FilePath
+      -- ^ I expect the output of running the script named <first argument> to match the golden file <second argument>.
+      -- The path of the golden file is relative to the `.daml` test file.
     | EvaluationOrder EvaluationOrder
+      -- ^ Only run this test with the given evaluation order.
 
 readFileAnns :: FilePath -> IO [Ann]
 readFileAnns file = do
@@ -484,6 +580,7 @@ readFileAnns file = do
             ("QUERY-LF-STREAM", x) -> Just $ QueryLF x True
             ("SCRIPT-V2", _) -> Just ScriptV2
             ("TODO",x) -> Just $ Todo x
+            ("LEDGER", words -> [script, path]) -> Just $ Ledger script path
             ("EVALUATION-ORDER", x) -> EvaluationOrder <$> readMaybe x
             _ -> error $ "Can't understand test annotation in " ++ show file ++ ", got " ++ show x
         f _ = Nothing
@@ -519,7 +616,7 @@ parseRange s =
         (Position (rowEnd - 1) (colEnd - 1))
     _ -> error $ "Failed to parse range, got " ++ s
 
-mainProj :: IdeState -> FilePath -> (String -> IO ()) -> NormalizedFilePath -> IO (LF.Package, FilePath)
+mainProj :: IdeState -> FilePath -> (String -> IO ()) -> NormalizedFilePath -> IO (LF.Package, FilePath, HashMap.HashMap T.Text T.Text)
 mainProj service outdir log file = do
     let proj = takeBaseName (fromNormalizedFilePath file)
 
@@ -542,9 +639,9 @@ mainProj service outdir log file = do
             corePrettyPrint core
             lf <- lfTypeCheck log file
             lfSave lf
-            lfRunScripts log file
+            scriptResults <- lfRunScripts log file
             jsonSave lf
-            pure (lf, jsonPath)
+            pure (lf, jsonPath, scriptResults)
 
 unjust :: Action (Maybe b) -> Action b
 unjust act = do
@@ -567,8 +664,30 @@ lfConvert log file = timed log "LF convert" $ unjust $ getRawDalf file
 lfTypeCheck :: (String -> IO ()) -> NormalizedFilePath -> Action LF.Package
 lfTypeCheck log file = timed log "LF type check" $ unjust $ getDalf file
 
-lfRunScripts :: (String -> IO ()) -> NormalizedFilePath -> Action ()
-lfRunScripts log file = timed log "LF scripts execution" $ void $ unjust $ runScripts file
+lfRunScripts :: (String -> IO ()) -> NormalizedFilePath -> Action (HashMap.HashMap T.Text T.Text)
+lfRunScripts log file = timed log "LF scripts execution" $ do
+    world <- worldForFile file
+    results <- unjust $ runScripts file
+    pure $ HashMap.fromList
+        [ (vrScenarioName k, format world res)
+        | (k, res) <- results
+        , vrScenarioFile k == file
+        ]
+    where
+        format world
+          = renderPlain
+          . ($$ text "") -- add a newline at the end to appease git
+          . \case
+              Right res ->
+                let activeContracts = S.fromList (V.toList (SS.scenarioResultActiveContracts res))
+                in prettyScenarioResult lvl world activeContracts res
+              Left (SS.ScenarioError err) ->
+                prettyScenarioError lvl world err
+              Left e ->
+                shown e
+        lvl =
+          -- hide package ids
+          PrettyLevel (-1)
 
 timed :: MonadIO m => (String -> IO ()) -> String -> m a -> m a
 timed log msg act = do