New EXPERIMENTAL command to sync file state with codebase

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

@@ -73,6 +73,7 @@ module Unison.Codebase.Branch
     -- *** Libdep manipulations
     withoutLib,
     withoutTransitiveLibs,
+    onlyLib,
     deleteLibdep,
     deleteLibdeps,
 
@@ -184,6 +185,11 @@ withoutTransitiveLibs b0 =
             )
    in b0 & children .~ newChildren
 
+onlyLib :: Branch0 m -> Branch0 m
+onlyLib b =
+  let newChildren = (Map.singleton NameSegment.libSegment (fromMaybe empty $ Map.lookup NameSegment.libSegment (b ^. children)))
+   in branch0 mempty mempty newChildren mempty
+
 -- | @deleteLibdep name branch@ deletes the libdep named @name@ from @branch@, if it exists.
 deleteLibdep :: NameSegment -> Branch0 m -> Branch0 m
 deleteLibdep dep =

parser-typechecker/src/Unison/UnisonFile.hs

@@ -36,6 +36,8 @@ module Unison.UnisonFile
     typecheckedUnisonFile,
     Unison.UnisonFile.rewrite,
     prepareRewrite,
+    typeLookupForTypecheckedFile,
+    typeOfReferentFromTypecheckedUnisonFile,
   )
 where
 
@@ -56,6 +58,7 @@ import Unison.LabeledDependency qualified as LD
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
+import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
 import Unison.Term (Term)
 import Unison.Term qualified as Term
@@ -355,6 +358,33 @@ declsToTypeLookup uf =
   where
     wrangle = Map.fromList . Map.elems
 
+-- | Provides a lookup for all types and terms within the unison file.
+typeLookupForTypecheckedFile :: Var v => TypecheckedUnisonFile v a -> TL.TypeLookup v a
+typeLookupForTypecheckedFile tf =
+  TL.TypeLookup
+    termTypeLookup
+    (wrangle $ dataDeclarationsId' tf)
+    (wrangle $ effectDeclarationsId' tf)
+  where
+    termTypeLookup =
+      hashTermsId tf
+        & Map.elems
+        & fmap
+          (\(_ann, termRefId, _wk, _trm, typ) -> (Reference.DerivedId termRefId, typ))
+        & Map.fromList
+    wrangle = Map.fromList . fmap (first Reference.DerivedId) . Map.elems
+
+-- | Gets the type of a reference from either the parsed file or the codebase.
+typeOfReferentFromTypecheckedUnisonFile :: Var v => TypecheckedUnisonFile v a -> Referent -> Maybe (Type v a)
+typeOfReferentFromTypecheckedUnisonFile tf = \case
+  Referent.Ref reference ->
+    Map.lookup reference typeOfTerms
+  Referent.Con (ConstructorReference typeReference cid) _type -> do
+    decl <- Map.lookup typeReference dataDecls <|> (DD.toDataDecl <$> Map.lookup typeReference effectDecls)
+    DD.typeOfConstructor decl cid
+  where
+    TL.TypeLookup {typeOfTerms, dataDecls, effectDecls} = typeLookupForTypecheckedFile tf
+
 -- Returns true if the file has any definitions or watches
 nonEmpty :: TypecheckedUnisonFile v a -> Bool
 nonEmpty uf =

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

@@ -65,7 +65,8 @@ import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI)
 import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
 import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib)
-import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile)
+import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), LoadMode (LoadForCommit), evalUnisonFile, handleLoad)
+import Unison.Codebase.Editor.HandleInput.Load qualified as Load
 import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge)
 import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll)
 import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch)
@@ -189,14 +190,16 @@ import UnliftIO.Directory qualified as Directory
 ------------------------------------------------------------------------------------------------------------------------
 -- Main loop
 
-loop :: Either Event Input -> Cli ()
-loop e = do
+loop :: LoadMode -> Either Event Input -> Cli ()
+loop loadMode e = do
   case e of
     Left (UnisonFileChanged sourceName text) -> Cli.time "UnisonFileChanged" do
       -- We skip this update if it was programmatically generated
       Cli.getLatestFile >>= \case
         Just (_, True) -> (#latestFile . _Just . _2) .= False
-        _ -> loadUnisonFile sourceName text
+        _ -> case loadMode of
+          Load.LoadForCommit -> void $ Load.loadUnisonFileForCommit False sourceName text
+          Load.Normal -> void $ Load.loadUnisonFile sourceName text
     Right input ->
       let previewResponse sourceName sr uf = do
             names <- Cli.currentNames
@@ -707,7 +710,7 @@ loop e = do
             FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input
             StructuredFindI _fscope ws -> handleStructuredFindI ws
             StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws
-            LoadI maybePath -> handleLoad maybePath
+            LoadI maybePath -> void $ handleLoad True loadMode maybePath
             ClearI -> Cli.respond ClearScreen
             AddI requestedNames -> do
               description <- inputDescription input
@@ -732,6 +735,21 @@ loop e = do
               currentNames <- Branch.toNames <$> Cli.getCurrentBranch0
               let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames
               previewResponse sourceName sr uf
+            CommitI mayScratchFile -> do
+              uf <- handleLoad False LoadForCommit mayScratchFile
+              currentPath <- Cli.getCurrentPath
+              libNames <-
+                Cli.getCurrentBranch0
+                  <&> Branch.onlyLib
+                  <&> Branch.toNames
+              let sr = Slurp.slurpFile uf mempty Slurp.AddOp libNames
+              let adds = SlurpResult.adds sr
+              Cli.Env {codebase} <- ask
+              Cli.runTransaction . Codebase.addDefsToCodebase codebase $ uf
+              description <- inputDescription input
+              Cli.stepAt description (Path.unabsolute currentPath, doSlurpAdds adds uf . Branch.onlyLib)
+            CommitPreviewI mayScratchFile -> do
+              void $ handleLoad False LoadForCommit mayScratchFile
             UpdateI optionalPatch requestedNames -> handleUpdate input optionalPatch requestedNames
             Update2I -> handleUpdate2
             PreviewUpdateI requestedNames -> do
@@ -1051,6 +1069,8 @@ inputDescription input =
         DeleteTarget'ProjectBranch _ -> wat
         DeleteTarget'Project _ -> wat
     AddI _selection -> pure "add"
+    CommitI mayScratchFile -> pure ("experimental.commit" <> maybe "" Text.pack mayScratchFile)
+    CommitPreviewI mayScratchFile -> pure ("experimental.commit.preview" <> maybe "" Text.pack mayScratchFile)
     UpdateI p0 _selection -> do
       p <-
         case p0 of

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

@@ -0,0 +1,4 @@
+module Unison.Codebase.Editor.HandleInput.Commit (commitDiff) where
+
+commitDiff :: ()
+commitDiff = ()

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

@@ -1,6 +1,8 @@
 module Unison.Codebase.Editor.HandleInput.Load
   ( handleLoad,
     loadUnisonFile,
+    loadUnisonFileForCommit,
+    LoadMode (..),
     EvalMode (..),
     evalUnisonFile,
   )
@@ -20,9 +22,14 @@ import Unison.Cli.PrettyPrintUtils qualified as Cli
 import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
 import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
 import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Branch qualified as Branch
+import Unison.Codebase.Branch.Names qualified as Branch
+import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffFromTypecheckedUnisonFile)
 import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
+import Unison.Codebase.Editor.HandleInput.Update qualified as Update
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Editor.Slurp qualified as Slurp
+import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.FileParsers qualified as FileParsers
 import Unison.Names (Names)
@@ -43,8 +50,15 @@ import Unison.UnisonFile (TypecheckedUnisonFile)
 import Unison.UnisonFile.Names qualified as UF
 import Unison.WatchKind qualified as WK
 
-handleLoad :: Maybe FilePath -> Cli ()
-handleLoad maybePath = do
+data LoadMode
+  = Normal
+  | -- Load a file without any names from the codebase except for library dependencies.
+    -- This mode is used for _replacing_ the current branch whole-sale with code from a scratch file.
+    LoadForCommit
+  deriving (Show, Eq, Ord)
+
+handleLoad :: Bool -> LoadMode -> Maybe FilePath -> Cli (TypecheckedUnisonFile Symbol Ann)
+handleLoad showWatchExprs loadMode maybePath = do
   latestFile <- Cli.getLatestFile
   path <- (maybePath <|> fst <$> latestFile) & onNothing (Cli.returnEarly Output.NoUnisonFile)
   Cli.Env {loadSource} <- ask
@@ -53,9 +67,11 @@ handleLoad maybePath = do
       Cli.InvalidSourceNameError -> Cli.returnEarly $ Output.InvalidSourceName path
       Cli.LoadError -> Cli.returnEarly $ Output.SourceLoadFailed path
       Cli.LoadSuccess contents -> pure contents
-  loadUnisonFile (Text.pack path) contents
+  case loadMode of
+    Normal -> loadUnisonFile (Text.pack path) contents
+    LoadForCommit -> loadUnisonFileForCommit showWatchExprs (Text.pack path) contents
 
-loadUnisonFile :: Text -> Text -> Cli ()
+loadUnisonFile :: Text -> Text -> Cli (TypecheckedUnisonFile Symbol Ann)
 loadUnisonFile sourceName text = do
   Cli.respond $ Output.LoadingFile sourceName
   currentNames <- Cli.currentNames
@@ -71,51 +87,78 @@ loadUnisonFile sourceName text = do
   when (not (null e')) do
     Cli.respond $ Output.Evaluated text ppe bindings e'
   #latestTypecheckedFile .= Just (Right unisonFile)
-  where
-    withFile ::
-      Names ->
-      Text ->
-      Text ->
-      Cli (TypecheckedUnisonFile Symbol Ann)
-    withFile names sourceName text = do
+  pure unisonFile
+
+loadUnisonFileForCommit :: Bool -> Text -> Text -> Cli (TypecheckedUnisonFile Symbol Ann)
+loadUnisonFileForCommit showWatchExprs sourceName text = do
+  Cli.respond $ Output.LoadingFile sourceName
+  beforeBranch0 <- Cli.getCurrentBranch0
+  let beforeBranch0LibOnly = Branch.onlyLib beforeBranch0
+  beforePPED <- Cli.currentPrettyPrintEnvDecl
+  let libNames = Branch.toNames beforeBranch0LibOnly
+  unisonFile <- withFile libNames sourceName text
+  let sr = Slurp.slurpFile unisonFile mempty Slurp.CheckOp libNames
+  let adds = SlurpResult.adds sr
+  let afterBranch0 = Update.doSlurpAdds adds unisonFile beforeBranch0LibOnly
+  afterPPED <- Cli.prettyPrintEnvDeclFromNames (Branch.toNames afterBranch0)
+  (_ppe, diff) <- diffFromTypecheckedUnisonFile unisonFile beforeBranch0 afterBranch0
+  let pped = afterPPED `PPED.addFallback` beforePPED
+  let ppe = PPE.suffixifiedPPE pped
+  currentPath <- Cli.getCurrentPath
+  Cli.respondNumbered $ Output.ShowDiffNamespace (Right currentPath) (Right currentPath) ppe diff
+  when showWatchExprs do
+    (bindings, e) <- evalUnisonFile Permissive ppe unisonFile []
+    let e' = Map.map go e
+        go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit)
+    when (not (null e')) do
+      Cli.respond $ Output.Evaluated text ppe bindings e'
+  #latestTypecheckedFile .= Just (Right unisonFile)
+  pure unisonFile
+
+withFile ::
+  Names ->
+  Text ->
+  Text ->
+  Cli (TypecheckedUnisonFile Symbol Ann)
+withFile names sourceName text = do
+  currentPath <- Cli.getCurrentPath
+  State.modify' \loopState ->
+    loopState
+      & #latestFile .~ Just (Text.unpack sourceName, False)
+      & #latestTypecheckedFile .~ Nothing
+  Cli.Env {codebase, generateUniqueName} <- ask
+  uniqueName <- liftIO generateUniqueName
+  let parsingEnv =
+        Parser.ParsingEnv
+          { uniqueNames = uniqueName,
+            uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath,
+            names
+          }
+  unisonFile <-
+    Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv)
+      & onLeftM \err -> Cli.returnEarly (Output.ParseErrors text [err])
+  -- set that the file at least parsed (but didn't typecheck)
+  State.modify' (& #latestTypecheckedFile .~ Just (Left unisonFile))
+  typecheckingEnv <-
+    Cli.runTransaction do
+      computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] unisonFile
+  let Result.Result notes maybeTypecheckedUnisonFile = FileParsers.synthesizeFile typecheckingEnv unisonFile
+  maybeTypecheckedUnisonFile & onNothing do
+    let namesWithFileDefinitions = UF.addNamesFromUnisonFile unisonFile names
+    pped <- Cli.prettyPrintEnvDeclFromNames namesWithFileDefinitions
+    let suffixifiedPPE = PPED.suffixifiedPPE pped
+    let tes = [err | Result.TypeError err <- toList notes]
+        cbs =
+          [ bug
+            | Result.CompilerBug (Result.TypecheckerBug bug) <-
+                toList notes
+          ]
+    when (not (null tes)) do
       currentPath <- Cli.getCurrentPath
-      State.modify' \loopState ->
-        loopState
-          & #latestFile .~ Just (Text.unpack sourceName, False)
-          & #latestTypecheckedFile .~ Nothing
-      Cli.Env {codebase, generateUniqueName} <- ask
-      uniqueName <- liftIO generateUniqueName
-      let parsingEnv =
-            Parser.ParsingEnv
-              { uniqueNames = uniqueName,
-                uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath,
-                names
-              }
-      unisonFile <-
-        Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv)
-          & onLeftM \err -> Cli.returnEarly (Output.ParseErrors text [err])
-      -- set that the file at least parsed (but didn't typecheck)
-      State.modify' (& #latestTypecheckedFile .~ Just (Left unisonFile))
-      typecheckingEnv <-
-        Cli.runTransaction do
-          computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] unisonFile
-      let Result.Result notes maybeTypecheckedUnisonFile = FileParsers.synthesizeFile typecheckingEnv unisonFile
-      maybeTypecheckedUnisonFile & onNothing do
-        let namesWithFileDefinitions = UF.addNamesFromUnisonFile unisonFile names
-        pped <- Cli.prettyPrintEnvDeclFromNames namesWithFileDefinitions
-        let suffixifiedPPE = PPED.suffixifiedPPE pped
-        let tes = [err | Result.TypeError err <- toList notes]
-            cbs =
-              [ bug
-                | Result.CompilerBug (Result.TypecheckerBug bug) <-
-                    toList notes
-              ]
-        when (not (null tes)) do
-          currentPath <- Cli.getCurrentPath
-          Cli.respond (Output.TypeErrors currentPath text suffixifiedPPE tes)
-        when (not (null cbs)) do
-          Cli.respond (Output.CompilerBugs text suffixifiedPPE cbs)
-        Cli.returnEarlyWithoutOutput
+      Cli.respond (Output.TypeErrors currentPath text suffixifiedPPE tes)
+    when (not (null cbs)) do
+      Cli.respond (Output.CompilerBugs text suffixifiedPPE cbs)
+    Cli.returnEarlyWithoutOutput
 
 data EvalMode = Sandboxed | Permissive | Native
 

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

@@ -1,6 +1,7 @@
 -- | Helpers/utils that have to do with namespace diffs.
 module Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils
   ( diffHelper,
+    diffFromTypecheckedUnisonFile,
   )
 where
 
@@ -24,8 +25,14 @@ import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
+import Unison.Referent qualified as Referent
 import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol (Symbol)
+import Unison.Type (Type)
+import Unison.Typechecker.TypeLookup qualified as TL
+import Unison.UnisonFile (TypecheckedUnisonFile)
+import Unison.UnisonFile qualified as UF
+import Unison.UnisonFile.Names qualified as Names
 
 diffHelper ::
   Branch0 IO ->
@@ -48,6 +55,46 @@ diffHelper before after =
         (Branch.toNames after)
         diff
 
+-- | Like diffHelper, but allows providing definitions from a file which may not have been added to the codebase
+-- yet.
+diffFromTypecheckedUnisonFile ::
+  TypecheckedUnisonFile Symbol Ann ->
+  Branch0 IO ->
+  Branch0 IO ->
+  Cli (PPE.PrettyPrintEnv, OBranchDiff.BranchDiffOutput Symbol Ann)
+diffFromTypecheckedUnisonFile tf before after = do
+  Cli.time "diffFromTypecheckedUnisonFile" do
+    Cli.Env {codebase} <- ask
+    hqLength <- Cli.runTransaction Codebase.hashLength
+    diff <- liftIO (BranchDiff.diff0 before after)
+    names <- Cli.currentNames
+    pped <- Cli.prettyPrintEnvDeclFromNames names
+    let suffixifiedPPE = PPED.suffixifiedPPE pped
+    let beforeNames = Branch.toNames before
+    let afterNames = Names.addNamesFromTypeCheckedUnisonFile tf (Branch.toNames after)
+    fmap (suffixifiedPPE,) do
+      OBranchDiff.toOutput
+        (getTypeOfReferent codebase)
+        (getDeclOrBuiltin codebase)
+        hqLength
+        beforeNames
+        afterNames
+        diff
+  where
+    TL.TypeLookup {dataDecls, effectDecls} = UF.typeLookupForTypecheckedFile tf
+    referentTypeFromFile :: Referent.Referent -> (Maybe (Type Symbol Ann))
+    referentTypeFromFile ref = UF.typeOfReferentFromTypecheckedUnisonFile tf ref
+    getDeclOrBuiltin :: Codebase m Symbol Ann -> Reference -> Cli (Maybe (DD.DeclOrBuiltin Symbol Ann))
+    getDeclOrBuiltin codebase ref = runMaybeT do
+      hoistMaybe (Map.lookup ref dataDecls <&> DD.Decl . Right)
+        <|> hoistMaybe ((Map.lookup ref effectDecls) <&> DD.Decl . Left)
+        <|> (MaybeT (Cli.runTransaction $ declOrBuiltin codebase ref))
+    getTypeOfReferent codebase ref =
+      runMaybeT $
+        do
+          (hoistMaybe $ referentTypeFromFile ref)
+          <|> (MaybeT . Cli.runTransaction $ Codebase.getTypeOfReferent codebase ref)
+
 declOrBuiltin :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (Maybe (DD.DeclOrBuiltin Symbol Ann))
 declOrBuiltin codebase r = case r of
   Reference.Builtin {} ->