diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index efefd1906..2dae6a07f 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/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) diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index ffb0c4c20..b20378c5e 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/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 diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 8067cf463..914581664 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/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 diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index f6400ae67..ca74688fd 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/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) diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 56a339408..5810df590 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/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)