Add isTranscriptTest to Cli.Env

unison-cli/src/Unison/Cli/Monad.hs

@@ -177,7 +177,10 @@ data Env = Env
     sandboxedRuntime :: Runtime Symbol,
     nativeRuntime :: Runtime Symbol,
     serverBaseUrl :: Maybe Server.BaseUrl,
-    ucmVersion :: UCMVersion
+    ucmVersion :: UCMVersion,
+    -- | Whether we're running in a transcript test or not.
+    -- Avoid using this except when absolutely necessary.
+    isTranscriptTest :: Bool
   }
   deriving stock (Generic)
 

unison-cli/src/Unison/Codebase/TranscriptParser.hs

@@ -195,19 +195,20 @@ type TranscriptRunner =
 withTranscriptRunner ::
   forall m r.
   (UnliftIO.MonadUnliftIO m) =>
+  Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} ->
   Verbosity ->
   UCMVersion ->
   FilePath ->
   Maybe FilePath ->
   (TranscriptRunner -> m r) ->
   m r
-withTranscriptRunner verbosity ucmVersion nrtp configFile action = do
+withTranscriptRunner isTest verbosity ucmVersion nrtp configFile action = do
   withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do
     action \transcriptName transcriptSrc (codebaseDir, codebase) -> do
       Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do
         let parsed = parse transcriptName transcriptSrc
         result <- for parsed \stanzas -> do
-          liftIO $ run verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl)
+          liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl)
         pure $ join @(Either TranscriptError) result
   where
     withRuntimes ::
@@ -232,6 +233,7 @@ withTranscriptRunner verbosity ucmVersion nrtp configFile action = do
             (\(config, _cancelConfig) -> action (Just config))
 
 run ::
+  Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} ->
   Verbosity ->
   FilePath ->
   [Stanza] ->
@@ -243,7 +245,7 @@ run ::
   UCMVersion ->
   Text ->
   IO (Either TranscriptError Text)
-run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do
+run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do
   httpManager <- HTTP.newManager HTTP.defaultManagerSettings
   (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do
     (_, emptyCausalHashId) <- Codebase.emptyCausalHash
@@ -550,7 +552,8 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion
             sandboxedRuntime = sbRuntime,
             nativeRuntime = nRuntime,
             serverBaseUrl = Nothing,
-            ucmVersion
+            ucmVersion,
+            isTranscriptTest = isTest
           }
 
   let loop :: Cli.LoopState -> IO Text

unison-cli/src/Unison/CommandLine/Main.hs

@@ -234,7 +234,8 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase
             sandboxedRuntime = sbRuntime,
             nativeRuntime = nRuntime,
             serverBaseUrl,
-            ucmVersion
+            ucmVersion,
+            isTranscriptTest = False
           }
 
   (onInterrupt, waitForInterrupt) <- buildInterruptHandler

unison-cli/src/Unison/Main.hs

@@ -425,7 +425,8 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles
   configFilePath <- getConfigFilePath mcodepath
   -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously.
   and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do
-    TR.withTranscriptRunner Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do
+    let isTest = False
+    TR.withTranscriptRunner isTest Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do
       for markdownFiles $ \(MarkdownFile fileName) -> do
         transcriptSrc <- readUtf8 fileName
         result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase)

unison-cli/transcripts/Transcripts.hs

@@ -47,7 +47,8 @@ testBuilder ::
   Test ()
 testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do
   outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do
-    withTranscriptRunner Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do
+    let isTest = True
+    withTranscriptRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do
       for files \filePath -> do
         transcriptSrc <- readUtf8 filePath
         out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase)