Add support for “known failures” to transcripts

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

@@ -2,7 +2,7 @@
 
 -- | The data model for Unison transcripts.
 module Unison.Codebase.Transcript
-  ( ExpectingError,
+  ( Result (..),
     ScratchFileName,
     Hidden (..),
     UcmLine (..),
@@ -19,7 +19,7 @@ import Unison.Core.Project (ProjectBranchName, ProjectName)
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch)
 
-type ExpectingError = Bool
+data Result = Success | Incorrect | Error | Failure
 
 type ScratchFileName = Text
 
@@ -45,6 +45,6 @@ pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info bod
 type Stanza = Either CMark.Node ProcessedBlock
 
 data ProcessedBlock
-  = Ucm Hidden ExpectingError [UcmLine]
-  | Unison Hidden ExpectingError (Maybe ScratchFileName) Text
+  = Ucm Hidden Result [UcmLine]
+  | Unison Hidden Result (Maybe ScratchFileName) Text
   | API [APIRequest]

unison-cli/src/Unison/Codebase/Transcript/Parser.hs

@@ -142,8 +142,12 @@ hidden =
     <|> (HideOutput <$ word ":hide")
     <|> pure Shown
 
-expectingError :: P ExpectingError
-expectingError = isJust <$> optional (word ":error")
+expectingError :: P Result
+expectingError =
+  (Error <$ word ":error")
+    <|> (Failure <$ word ":failure")
+    <|> (Incorrect <$ word ":incorrect")
+    <|> pure Success
 
 untilSpace1 :: P Text
 untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace)

unison-cli/src/Unison/Codebase/Transcript/Runner.hs

@@ -159,7 +159,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion
   unisonFiles <- newIORef Map.empty
   out <- newIORef mempty
   hidden <- newIORef Shown
-  allowErrors <- newIORef False
+  allowErrors <- newIORef Success
   hasErrors <- newIORef False
   mStanza <- newIORef Nothing
   traverse_ (atomically . Q.enqueue inputQueue) (stanzas `zip` (Just <$> [1 :: Int ..]))
@@ -265,18 +265,25 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion
                           Left msg -> do
                             liftIO $ writeIORef hasErrors True
                             liftIO (readIORef allowErrors) >>= \case
-                              True -> do
-                                liftIO (output . Pretty.toPlain terminalWidth $ ("\n" <> msg <> "\n"))
+                              Success -> liftIO . dieWithMsg $ Pretty.toPlain terminalWidth msg
+                              Incorrect ->
+                                liftIO . dieWithMsg . Pretty.toPlain terminalWidth $
+                                  "The stanza above previously had an incorrect successful result, but now fails with"
+                                    <> "\n"
+                                    <> Pretty.border 2 msg
+                                    <> "\n"
+                                    <> "if this is the expected result, replace `:incorrect` with `:error`, otherwise "
+                                    <> "change `:incorrect` to `:failure`."
+                              _ -> do
+                                liftIO . output . Pretty.toPlain terminalWidth $ "\n" <> msg <> "\n"
                                 awaitInput
-                              False -> do
-                                liftIO (dieWithMsg $ Pretty.toPlain terminalWidth msg)
                           -- No input received from this line, try again.
                           Right Nothing -> awaitInput
                           Right (Just (_expandedArgs, input)) -> pure $ Right input
           Nothing -> do
             liftIO (dieUnexpectedSuccess)
             liftIO (writeIORef hidden Shown)
-            liftIO (writeIORef allowErrors False)
+            liftIO (writeIORef allowErrors Success)
             maybeStanza <- atomically (Q.tryDequeue inputQueue)
             _ <- liftIO (writeIORef mStanza maybeStanza)
             case maybeStanza of
@@ -365,21 +372,21 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion
         errOk <- readIORef allowErrors
         let rendered = Pretty.toPlain terminalWidth (Pretty.border 2 msg)
         output rendered
-        when (Output.isFailure o) $
-          if errOk
-            then writeIORef hasErrors True
-            else dieWithMsg rendered
+        when (Output.isFailure o) case errOk of
+          Success -> dieWithMsg rendered
+          Incorrect -> dieWithMsg rendered
+          _ -> writeIORef hasErrors True
 
       printNumbered :: Output.NumberedOutput -> IO Output.NumberedArgs
       printNumbered o = do
         let (msg, numberedArgs) = notifyNumbered o
         errOk <- readIORef allowErrors
         let rendered = Pretty.toPlain terminalWidth (Pretty.border 2 msg)
         output rendered
-        when (Output.isNumberedFailure o) $
-          if errOk
-            then writeIORef hasErrors True
-            else dieWithMsg rendered
+        when (Output.isNumberedFailure o) case errOk of
+          Success -> dieWithMsg rendered
+          Incorrect -> dieWithMsg rendered
+          _ -> writeIORef hasErrors True
         pure numberedArgs
 
       -- Looks at the current stanza and decides if it is contained in the
@@ -404,10 +411,16 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion
       dieUnexpectedSuccess = do
         errOk <- readIORef allowErrors
         hasErr <- readIORef hasErrors
-        when (errOk && not hasErr) $ do
-          output "\n```\n\n"
-          appendFailingStanza
-          transcriptFailure out "The transcript was expecting an error in the stanza above, but did not encounter one."
+        case (errOk, hasErr) of
+          (Error, False) -> do
+            output "\n```\n\n"
+            appendFailingStanza
+            transcriptFailure out "The transcript was expecting an error in the stanza above, but did not encounter one."
+          (Failure, False) -> do
+            output "\n```\n\n"
+            appendFailingStanza
+            transcriptFailure out "The stanza above is now passing! Please remove `:failure` from it."
+          (_, _) -> pure ()
 
   authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion
 

unison-src/transcripts-using-base/fix5178.md

@@ -0,0 +1,20 @@
+```unison
+foo = {{
+@source{Stream.emit}
+}}
+```
+
+```ucm
+scratch/main> add
+```
+
+Viewing `foo` via `scratch/main> ui` shows the correct source, but `display foo` gives us an error message (but not an error – this is incorrectly considered a successful result)
+
+I think there are two separate issues here:
+
+1. this message should be considered an error, not success; and
+2. this should actually work like `ui` and give us the source of the ability member, not complain about there being no such term in the codebase.
+
+```ucm:incorrect
+scratch/main> display foo
+```

unison-src/transcripts-using-base/fix5178.output.md

@@ -0,0 +1,45 @@
+``` unison
+foo = {{
+@source{Stream.emit}
+}}
+```
+
+``` ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+
+    ⍟ These new definitions are ok to `add`:
+
+      foo : Doc2
+
+```
+``` ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+
+    foo : Doc2
+
+```
+Viewing `foo` via `scratch/main> ui` shows the correct source, but `display foo` gives us an error message (but not an error – this is incorrectly considered a successful result)
+
+I think there are two separate issues here:
+
+1.  this message should be considered an error, not success; and
+2.  this should actually work like `ui` and give us the source of the ability member, not complain about there being no such term in the codebase.
+
+``` ucm
+scratch/main> display foo
+
+      -- The name #rfi1v9429f is assigned to the reference
+      ShortHash {prefix =
+      "rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8",
+      cycle = Nothing, cid = Nothing}, which is missing from the
+      codebase.
+      Tip: You might need to repair the codebase manually.
+
+```

unison-src/transcripts/fix5337.md

@@ -0,0 +1,14 @@
+```ucm
+scratch/main> builtins.mergeio
+```
+
+The following `Doc` fails to typecheck with `ucm` `0.5.26`:
+
+```unison:failure
+testDoc : Doc2
+testDoc = {{
+  key: '{{ docWord "value" }}'.
+}}
+```
+
+The same code typechecks ok with `0.5.25`.

unison-src/transcripts/fix5337.output.md

@@ -0,0 +1,32 @@
+``` ucm
+scratch/main> builtins.mergeio
+
+  Done.
+
+```
+The following `Doc` fails to typecheck with `ucm` `0.5.26`:
+
+``` unison
+testDoc : Doc2
+testDoc = {{
+  key: '{{ docWord "value" }}'.
+}}
+```
+
+``` ucm
+
+  Loading changes detected in scratch.u.
+
+  I got confused here:
+
+      3 |   key: '{{ docWord "value" }}'.
+
+
+  I was surprised to find a . here.
+  I was expecting one of these instead:
+
+  * end of input
+
+```
+The same code typechecks ok with `0.5.25`.
+