⅄ trunk → 24-10-16-edit-dependents

.github/ISSUE_TEMPLATE/bug_report.md

@@ -8,33 +8,18 @@ assignees: ''
 ---
 
 **Describe and demonstrate the bug**
-Please attach a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g.
+This should be written as a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g.
 
-Input:
-```` markdown
 ``` unison :hide
 a = 1
 ```
-Here I typo the next command and `ucm` silently does nothing. I would have expected an error message:
-``` ucm
-.> add b
-```
-````
-
-Output:
-```` markdown
-``` unison
-a = 1
-```
 
 Here I typo the next command and `ucm` silently does nothing, I would have expected an error message:
-``` ucm
-.> add b
-
 
+``` ucm
+scratch/main> add b
 
 ```
-````
 
 **Screenshots**
 If applicable, add screenshots to help explain your problem.

.gitignore

@@ -25,6 +25,8 @@ dist-newstyle
 *.hie
 *.prof
 *.prof.html
+*.hp
+*.ps
 /.direnv/
 /.envrc
 

lib/unison-prelude/src/Unison/Debug.hs

@@ -36,6 +36,8 @@ data DebugFlag
   | -- | Useful for adding temporary debugging statements during development.
     -- Remove uses of Debug.Temp before merging to keep things clean for the next person :)
     Temp
+  | -- | Debugging the interpreter
+    Interpreter
   | -- | Shows Annotations when printing terms
     Annotations
   | -- | Debug endpoints of the local UI (or Share) server
@@ -65,6 +67,7 @@ debugFlags = case (unsafePerformIO (lookupEnv "UNISON_DEBUG")) of
       "LSP" -> pure LSP
       "TIMING" -> pure Timing
       "TEMP" -> pure Temp
+      "INTERPRETER" -> pure Interpreter
       "ANNOTATIONS" -> pure Annotations
       "SERVER" -> pure Server
       "PATTERN_COVERAGE" -> pure PatternCoverage
@@ -114,6 +117,10 @@ debugTemp :: Bool
 debugTemp = Temp `Set.member` debugFlags
 {-# NOINLINE debugTemp #-}
 
+debugInterpreter :: Bool
+debugInterpreter = Interpreter `Set.member` debugFlags
+{-# NOINLINE debugInterpreter #-}
+
 debugAnnotations :: Bool
 debugAnnotations = Annotations `Set.member` debugFlags
 {-# NOINLINE debugAnnotations #-}
@@ -187,6 +194,7 @@ shouldDebug = \case
   LSP -> debugLSP
   Timing -> debugTiming
   Temp -> debugTemp
+  Interpreter -> debugInterpreter
   Annotations -> debugAnnotations
   Server -> debugServer
   PatternCoverage -> debugPatternCoverage

nix/haskell-nix-flake.nix

@@ -32,6 +32,7 @@
         (args.nativeBuildInputs or [])
         ++ [
           pkgs.cachix
+          pkgs.gettext # for envsubst, used by unison-src/builtin-tests/interpreter-tests.sh
           pkgs.hpack
           pkgs.pkg-config
           pkgs.stack-wrapped

parser-typechecker/src/Unison/Codebase/Runtime.hs

@@ -34,7 +34,7 @@ data CompileOpts = COpts
   }
 
 defaultCompileOpts :: CompileOpts
-defaultCompileOpts = COpts { profile = False }
+defaultCompileOpts = COpts {profile = False}
 
 data Runtime v = Runtime
   { terminate :: IO (),

parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs

@@ -46,9 +46,9 @@ import Unison.Type (Type)
 import Unison.Util.Cache qualified as Cache
 import Unison.WatchKind qualified as UF
 import UnliftIO (finally)
-import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist)
 import UnliftIO qualified as UnliftIO
 import UnliftIO.Concurrent qualified as UnliftIO
+import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist)
 import UnliftIO.STM
 
 debug :: Bool

parser-typechecker/src/Unison/Syntax/TermPrinter.hs

@@ -1285,7 +1285,6 @@ instance Monoid PrintAnnotation where
 
 suffixCounterTerm :: (Var v) => PrettyPrintEnv -> Set Name -> Set Name -> Term2 v at ap v a -> PrintAnnotation
 suffixCounterTerm n usedTm usedTy = \case
-  Var' v -> countHQ mempty $ HQ.unsafeFromVar v
   Ref' r -> countHQ usedTm $ PrettyPrintEnv.termName n (Referent.Ref r)
   Constructor' r | noImportRefs (r ^. ConstructorReference.reference_) -> mempty
   Constructor' r -> countHQ usedTm $ PrettyPrintEnv.termName n (Referent.Con r CT.Data)

parser-typechecker/src/Unison/Typechecker.hs

@@ -21,7 +21,7 @@ where
 
 import Control.Lens
 import Control.Monad.Fail (fail)
-import Control.Monad.State (StateT, get, modify, execState, State)
+import Control.Monad.State (State, StateT, execState, get, modify)
 import Control.Monad.Writer
 import Data.Foldable
 import Data.Map qualified as Map
@@ -233,7 +233,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do
     addTypedComponent (Context.TopLevelComponent vtts) =
       for_ vtts \(v, typ, _) ->
         let name = Name.unsafeParseVar (Var.reset v)
-        in #topLevelComponents %= Map.insert name (NamedReference name typ (Context.ReplacementVar v))
+         in #topLevelComponents %= Map.insert name (NamedReference name typ (Context.ReplacementVar v))
     addTypedComponent _ = pure ()
 
     suggest :: [Resolution v loc] -> Result (Notes v loc) ()

parser-typechecker/src/Unison/Util/EnumContainers.hs

@@ -32,6 +32,7 @@ module Unison.Util.EnumContainers
 where
 
 import Data.Bifunctor
+import Data.Functor.Classes (Eq1, Ord1)
 import Data.IntMap.Strict qualified as IM
 import Data.IntSet qualified as IS
 import Data.Word (Word16, Word64)
@@ -60,7 +61,9 @@ newtype EnumMap k a = EM (IM.IntMap a)
     )
   deriving newtype
     ( Monoid,
-      Semigroup
+      Semigroup,
+      Eq1,
+      Ord1
     )
 
 newtype EnumSet k = ES IS.IntSet

parser-typechecker/src/Unison/Util/TQueue.hs

@@ -8,8 +8,11 @@ import UnliftIO.STM hiding (TQueue)
 
 data TQueue a = TQueue (TVar (Seq a)) (TVar Word64)
 
+prepopulatedIO :: forall a m. (MonadIO m) => Seq a -> m (TQueue a)
+prepopulatedIO as = TQueue <$> newTVarIO as <*> newTVarIO (fromIntegral $ length as)
+
 newIO :: forall a m. (MonadIO m) => m (TQueue a)
-newIO = TQueue <$> newTVarIO mempty <*> newTVarIO 0
+newIO = prepopulatedIO mempty
 
 size :: TQueue a -> STM Int
 size (TQueue q _) = S.length <$> readTVar q

unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md

@@ -1,5 +1,13 @@
 # Integration test: transcript
 
+``` ucm :hide
+scratch/main> builtins.mergeio lib.builtins
+
+scratch/main> load ./unison-src/transcripts-using-base/base.u
+
+scratch/main> add
+```
+
 ``` unison
 use lib.builtins
 
@@ -27,32 +35,30 @@ main = do
     _ -> ()
 ```
 
-``` ucm
-
+``` ucm :added-by-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`:
     
       structural ability Break
       type MyBool
       main   : '{IO, Exception} ()
       resume : Request {g, Break} x -> x
-
 ```
+
 ``` ucm
 scratch/main> add
 
   ⍟ I've added these definitions:
-  
+
     structural ability Break
     type MyBool
     main   : '{IO, Exception} ()
     resume : Request {g, Break} x -> x
 
 scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main
-
 ```

unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs

@@ -1,7 +1,7 @@
 module Unison.Codebase.Editor.HandleInput.FindAndReplace
   ( handleStructuredFindReplaceI,
     handleStructuredFindI,
-    handleTextFindI
+    handleTextFindI,
   )
 where
 
@@ -129,7 +129,8 @@ handleTextFindI allowLib tokens = do
         txts (Term.Float' haystack) = ABT.Found [Text.pack (show haystack)]
         txts (Term.Char' haystack) = ABT.Found [Text.pack [haystack]]
         txts (Term.Match' _ cases) = ABT.Found r
-          where r = join $ Pattern.foldMap' txtPattern . Term.matchPattern <$> cases
+          where
+            r = join $ Pattern.foldMap' txtPattern . Term.matchPattern <$> cases
         txts _ = ABT.Continue
         txtPattern (Pattern.Text _ txt) = [txt]
         txtPattern _ = []

unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs

@@ -4,9 +4,10 @@ module Unison.Codebase.Editor.HandleInput.RuntimeUtils
     evalPureUnison,
     displayDecompileErrors,
     selectRuntime,
-    EvalMode (..)
+    EvalMode (..),
   )
 where
+
 import Control.Lens
 import Control.Monad.Reader (ask)
 import Unison.ABT qualified as ABT
@@ -32,11 +33,11 @@ import Unison.WatchKind qualified as WK
 data EvalMode = Sandboxed | Permissive | Native
 
 selectRuntime :: EvalMode -> Cli (Runtime.Runtime Symbol)
-selectRuntime mode = ask <&> \case
-  Cli.Env { runtime, sandboxedRuntime, nativeRuntime }
-    | Permissive <- mode -> runtime
-    | Sandboxed <- mode -> sandboxedRuntime
-    | Native <- mode -> nativeRuntime
+selectRuntime mode =
+  ask <&> \Cli.Env {runtime, sandboxedRuntime, nativeRuntime} -> case mode of
+    Permissive -> runtime
+    Sandboxed -> sandboxedRuntime
+    Native -> nativeRuntime
 
 displayDecompileErrors :: [Runtime.Error] -> Cli ()
 displayDecompileErrors errs = Cli.respond (PrintMessage msg)

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -127,9 +127,10 @@ data Input
   | PullI !PullSourceTarget !PullMode
   | PushRemoteBranchI PushRemoteBranchInput
   | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -})
-  | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo?
+  | -- | used in Welcome module to give directions to user
+    --
+    -- todo: Q: Does it make sense to publish to not-the-root of a Github repo?
     --          Does it make sense to fork from not-the-root of a Github repo?
-    -- used in Welcome module to give directions to user
     CreateMessage (P.Pretty P.ColorText)
   | -- Change directory.
     SwitchBranchI Path'

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

@@ -10,7 +10,11 @@ module Unison.Codebase.Transcript
     APIRequest (..),
     pattern CMarkCodeBlock,
     Stanza,
+    InfoTags (..),
+    defaultInfoTags,
+    defaultInfoTags',
     ProcessedBlock (..),
+    CMark.Node,
   )
 where
 
@@ -24,27 +28,48 @@ type ExpectingError = Bool
 type ScratchFileName = Text
 
 data Hidden = Shown | HideOutput | HideAll
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Read, Show)
 
 data UcmLine
   = UcmCommand UcmContext Text
   | -- | Text does not include the '--' prefix.
     UcmComment Text
+  | UcmOutputLine Text
+  deriving (Eq, Show)
 
 -- | Where a command is run: a project branch (myproject/mybranch>).
 data UcmContext
   = UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName)
+  deriving (Eq, Show)
 
 data APIRequest
   = GetRequest Text
   | APIComment Text
+  | APIResponseLine Text
+  deriving (Eq, Show)
 
 pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node
 pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) []
 
 type Stanza = Either CMark.Node ProcessedBlock
 
+data InfoTags a = InfoTags
+  { hidden :: Hidden,
+    expectingError :: ExpectingError,
+    generated :: Bool,
+    additionalTags :: a
+  }
+  deriving (Eq, Ord, Read, Show)
+
+defaultInfoTags :: a -> InfoTags a
+defaultInfoTags = InfoTags Shown False False
+
+-- | If the `additionalTags` form a `Monoid`, then you don’t need to provide a default value for them.
+defaultInfoTags' :: (Monoid a) => InfoTags a
+defaultInfoTags' = defaultInfoTags mempty
+
 data ProcessedBlock
-  = Ucm Hidden ExpectingError [UcmLine]
-  | Unison Hidden ExpectingError (Maybe ScratchFileName) Text
-  | API [APIRequest]
+  = Ucm (InfoTags ()) [UcmLine]
+  | Unison (InfoTags (Maybe ScratchFileName)) Text
+  | API (InfoTags ()) [APIRequest]
+  deriving (Eq, Show)