Make an explicit 'CheckOp' constructor

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

@@ -262,7 +262,7 @@ loop = do
         let lexed = L.lexer (Text.unpack sourceName) (Text.unpack text)
         withFile [] sourceName (text, lexed) $ \unisonFile -> do
           currentNames <- currentPathNames
-          let sr = Slurp.slurpFile unisonFile mempty Nothing currentNames
+          let sr = Slurp.slurpFile unisonFile mempty Slurp.CheckOp currentNames
           names <- displayNames unisonFile
           pped <- prettyPrintEnvDecl names
           let ppe = PPE.suffixifiedPPE pped
@@ -1253,13 +1253,13 @@ loop = do
                     InvalidSourceNameError -> respond $ InvalidSourceName path
                     LoadError -> respond $ SourceLoadFailed path
                     LoadSuccess contents -> loadUnisonFile (Text.pack path) contents
-            AddI names -> do
-              let vars = Set.map Name.toVar names
+            AddI requestedNames -> do
+              let vars = Set.map Name.toVar requestedNames
               case uf of
                 Nothing -> respond NoUnisonFile
                 Just uf -> do
                   currentNames <- currentPathNames
-                  let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames
+                  let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames
                   let adds = SlurpResult.adds sr
                   stepAtNoSync Branch.CompressHistory (Path.unabsolute currentPath', doSlurpAdds adds uf)
                   eval . AddDefsToCodebase . filterBySlurpResult sr $ uf
@@ -1267,19 +1267,19 @@ loop = do
                   respond $ SlurpOutput input (PPE.suffixifiedPPE ppe) sr
                   addDefaultMetadata adds
                   syncRoot
-            PreviewAddI names -> case (latestFile', uf) of
+            PreviewAddI requestedNames -> case (latestFile', uf) of
               (Just (sourceName, _), Just uf) -> do
-                let vars = Set.map Name.toVar names
+                let vars = Set.map Name.toVar requestedNames
                 currentNames <- currentPathNames
-                let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames
+                let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames
                 previewResponse sourceName sr uf
               _ -> respond NoUnisonFile
-            UpdateI maybePatchPath names -> handleUpdate input maybePatchPath names
-            PreviewUpdateI names -> case (latestFile', uf) of
+            UpdateI maybePatchPath requestedNames -> handleUpdate input maybePatchPath requestedNames
+            PreviewUpdateI requestedNames -> case (latestFile', uf) of
               (Just (sourceName, _), Just uf) -> do
-                let vars = Set.map Name.toVar names
+                let vars = Set.map Name.toVar requestedNames
                 currentNames <- currentPathNames
-                let sr = Slurp.slurpFile uf vars (Just Slurp.UpdateOp) currentNames
+                let sr = Slurp.slurpFile uf vars Slurp.UpdateOp currentNames
                 previewResponse sourceName sr uf
               _ -> respond NoUnisonFile
             TodoI patchPath branchPath' -> do
@@ -1802,8 +1802,8 @@ handleShowDefinition outputLoc inputQuery = do
 
 -- | Handle an @update@ command.
 handleUpdate :: forall m v. (Monad m, Var v) => Input -> Maybe PatchPath -> Set Name -> Action' m v ()
-handleUpdate input maybePatchPath names = do
-  let vars = Set.map Name.toVar names
+handleUpdate input maybePatchPath requestedNames = do
+  let requestedVars = Set.map Name.toVar requestedNames
   use LoopState.latestTypecheckedFile >>= \case
     Nothing -> respond NoUnisonFile
     Just uf -> do
@@ -1818,7 +1818,7 @@ handleUpdate input maybePatchPath names = do
       let patchPath = fromMaybe defaultPatchPath maybePatchPath
       slurpCheckNames <- slurpResultNames
       let currentPathNames = slurpCheckNames
-      let sr = Slurp.slurpFile uf vars (Just Slurp.UpdateOp) slurpCheckNames
+      let sr = Slurp.slurpFile uf requestedVars Slurp.UpdateOp slurpCheckNames
           addsAndUpdates :: SlurpComponent v
           addsAndUpdates = Slurp.updates sr <> Slurp.adds sr
           fileNames :: Names

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

@@ -35,7 +35,11 @@ import qualified Unison.Var as Var
 import Unison.WatchKind (pattern TestWatch)
 
 -- | The operation which is being performed or checked.
-data SlurpOp = AddOp | UpdateOp
+data SlurpOp
+  = AddOp
+  | UpdateOp
+  | -- Run when the user saves the scratch file.
+    CheckOp
   deriving (Eq, Show)
 
 -- | Tag a variable as representing a term, type, or constructor
@@ -108,10 +112,10 @@ slurpFile ::
   Var v =>
   UF.TypecheckedUnisonFile v Ann ->
   Set v ->
-  Maybe SlurpOp ->
+  SlurpOp ->
   Names ->
   SR.SlurpResult v
-slurpFile uf defsToConsider maybeSlurpOp unalteredCodebaseNames =
+slurpFile uf defsToConsider slurpOp unalteredCodebaseNames =
   let -- A mapping of all vars in the file to their references.
       varReferences :: Map (TaggedVar v) LD.LabeledDependency
       varReferences = buildVarReferences uf
@@ -142,9 +146,6 @@ slurpFile uf defsToConsider maybeSlurpOp unalteredCodebaseNames =
         toSlurpResult uf slurpOp defsToConsider involvedVars fileNames codebaseNames summaries
    in pTraceShowId slurpResult
   where
-    slurpOp :: SlurpOp
-    slurpOp = fromMaybe UpdateOp maybeSlurpOp
-
     fileNames :: Names
     fileNames = UF.typecheckedToNames uf
 
@@ -157,11 +158,12 @@ computeNamesWithDeprecations ::
   Set (TaggedVar v) ->
   SlurpOp ->
   Names
-computeNamesWithDeprecations _uf unalteredCodebaseNames _involvedVars AddOp =
-  -- If we're 'adding', there won't be any deprecations.
-  unalteredCodebaseNames
-computeNamesWithDeprecations uf unalteredCodebaseNames involvedVars UpdateOp =
-  codebaseNames
+computeNamesWithDeprecations uf unalteredCodebaseNames involvedVars op =
+  case op of
+    AddOp ->
+      -- If we're 'adding', there won't be any deprecations to worry about.
+      unalteredCodebaseNames
+    _ -> codebaseNames
   where
     -- Get the set of all DIRECT definitions in the file which a definition depends on.
     codebaseNames :: Names
@@ -435,7 +437,7 @@ toSlurpResult uf op requestedVars involvedVars fileNames codebaseNames summarize
         SR.duplicates = duplicates,
         SR.collisions = if op == AddOp then updates else mempty,
         SR.conflicts = conflicts,
-        SR.updates = if op == UpdateOp then updates else mempty,
+        SR.updates = if op /= AddOp then updates else mempty,
         SR.termExistingConstructorCollisions =
           let SlurpComponent {types, terms, ctors} = termCtorColl
            in types <> terms <> ctors,
@@ -462,6 +464,8 @@ toSlurpResult uf op requestedVars involvedVars fileNames codebaseNames summarize
                           mempty {blocked = sc}
                         UpdateOp ->
                           mempty {adds = sc}
+                        CheckOp ->
+                          mempty {adds = sc}
                     ErrFrom _ TermCtorCollision -> mempty {blocked = sc}
                     ErrFrom _ CtorTermCollision -> mempty {blocked = sc}
                     ErrFrom _ Conflict -> mempty {blocked = sc}