Handle constructors explicitly in slurping

parser-typechecker/src/Unison/UnisonFile.hs

@@ -23,6 +23,7 @@ module Unison.UnisonFile
     discardTypes,
     effectDeclarations',
     hashConstructors,
+    constructorsForTypeVars,
     hashTerms,
     indexByReference,
     lookupDecl,
@@ -59,6 +60,7 @@ import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile (..), patt
 import qualified Unison.Util.List as List
 import Unison.Var (Var)
 import Unison.WatchKind (WatchKind, pattern TestWatch)
+
 dataDeclarations :: UnisonFile v a -> Map v (Reference, DataDeclaration v a)
 dataDeclarations = fmap (first Reference.DerivedId) . dataDeclarationsId
 
@@ -199,3 +201,20 @@ hashConstructors file =
       ctors2 = Map.elems (effectDeclarationsId' file) >>= \(ref, dd) ->
         [ (v, Referent.ConId (ConstructorReference ref i) CT.Effect) | (v,i) <- DD.constructorVars (DD.toDataDecl dd) `zip` [0 ..] ]
   in Map.fromList (ctors1 ++ ctors2)
+
+-- | Returns the set of constructor names for type names in the given `Set`.
+constructorsForTypeVars :: Ord v => Set v -> TypecheckedUnisonFile v a -> Set v
+constructorsForTypeVars types uf =
+  let dataConstructors =
+        dataDeclarationsId' uf
+          & Map.filterWithKey (\k _ -> Set.member k types)
+          & Map.elems
+          & fmap snd
+          & concatMap DD.constructorVars
+      effectConstructors =
+        effectDeclarationsId' uf
+          & Map.filterWithKey (\k _ -> Set.member k types)
+          & Map.elems
+          & fmap (DD.toDataDecl . snd)
+          & concatMap DD.constructorVars
+   in Set.fromList (dataConstructors <> effectConstructors)

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

@@ -1259,7 +1259,7 @@ loop = do
                 Nothing -> respond NoUnisonFile
                 Just uf -> do
                   currentNames <- currentPathNames
-                  let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames 
+                  let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames
                   let adds = SlurpResult.adds sr
                   stepAtNoSync Branch.CompressHistory (Path.unabsolute currentPath', doSlurpAdds adds uf)
                   eval . AddDefsToCodebase . filterBySlurpResult sr $ uf
@@ -1271,7 +1271,7 @@ loop = do
               (Just (sourceName, _), Just uf) -> do
                 let vars = Set.map Name.toVar names
                 currentNames <- currentPathNames
-                let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames 
+                let sr = Slurp.slurpFile uf vars (Just Slurp.AddOp) currentNames
                 previewResponse sourceName sr uf
               _ -> respond NoUnisonFile
             UpdateI maybePatchPath names -> handleUpdate input maybePatchPath names
@@ -1279,7 +1279,7 @@ loop = do
               (Just (sourceName, _), Just uf) -> do
                 let vars = Set.map Name.toVar names
                 currentNames <- currentPathNames
-                let sr = Slurp.slurpFile uf vars (Just Slurp.UpdateOp) currentNames 
+                let sr = Slurp.slurpFile uf vars (Just Slurp.UpdateOp) currentNames
                 previewResponse sourceName sr uf
               _ -> respond NoUnisonFile
             TodoI patchPath branchPath' -> 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 vars (Just Slurp.UpdateOp) slurpCheckNames
           addsAndUpdates :: SlurpComponent v
           addsAndUpdates = Slurp.updates sr <> Slurp.adds sr
           fileNames :: Names
@@ -2871,7 +2871,7 @@ doSlurpAdds slurp uf = Branch.batchUpdates (typeActions <> termActions)
     typeActions = map doType . toList $ SC.types slurp
     termActions =
       map doTerm . toList $
-        SC.terms slurp <> Slurp.constructorsFor (SC.types slurp) uf
+        SC.terms slurp <> UF.constructorsForTypeVars (SC.types slurp) uf
     names = UF.typecheckedToNames uf
     tests = Set.fromList $ fst <$> UF.watchesOfKind WK.TestWatch (UF.discardTypes uf)
     (isTestType, isTestValue) = isTest

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

@@ -345,7 +345,6 @@ varClosure :: (Var v) => UF.TypecheckedUnisonFile v a -> Set (TermOrTypeVar v) -
 varClosure uf (partitionVars OmitConstructors -> sc) =
   let deps = SC.closeWithDependencies uf sc
    in mingleVars deps
-        <> Set.map ConstructorVar (SR.constructorsFor (SC.types sc) uf)
 
 -- | Collect a relation of term or type var to labelled dependency for all definitions mentioned in a file.
 -- Contains types but not their constructors.
@@ -454,11 +453,11 @@ toSlurpResult uf op requestedVars involvedVars fileNames codebaseNames varsBySta
         SR.conflicts = conflicts,
         SR.updates = if op == UpdateOp then updates else mempty,
         SR.termExistingConstructorCollisions =
-          let SlurpComponent types terms = termCtorColl
-           in types <> terms,
+          let SlurpComponent {types, terms, ctors} = termCtorColl
+           in types <> terms <> ctors,
         SR.constructorExistingTermCollisions =
-          let SlurpComponent types terms = ctorTermColl
-           in types <> terms,
+          let SlurpComponent {types, terms, ctors} = ctorTermColl
+           in types <> terms <> ctors,
         SR.termAlias = termAliases,
         SR.typeAlias = typeAliases,
         SR.defsWithBlockedDependencies = blocked
@@ -548,6 +547,7 @@ partitionVars ctorHandling =
 
 -- | Collapse a SlurpComponent into a tagged set.
 mingleVars :: Ord v => SlurpComponent v -> Set (TermOrTypeVar v)
-mingleVars SlurpComponent {terms, types} =
+mingleVars SlurpComponent {terms, types, ctors} =
   Set.map TypeVar types
     <> Set.map TermVar terms
+    <> Set.map ConstructorVar ctors

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

@@ -15,30 +15,33 @@ import qualified Unison.Term as Term
 import qualified Unison.UnisonFile as UF
 
 data SlurpComponent v =
-  SlurpComponent { types :: Set v, terms :: Set v }
+  SlurpComponent { types :: Set v, terms :: Set v, ctors :: Set v }
   deriving (Eq,Ord,Show)
 
 isEmpty :: SlurpComponent v -> Bool
-isEmpty sc = Set.null (types sc) && Set.null (terms sc)
+isEmpty sc = Set.null (types sc) && Set.null (terms sc) && Set.null (ctors sc)
 
 empty :: Ord v => SlurpComponent v
-empty = SlurpComponent {types=mempty, terms=mempty}
+empty = SlurpComponent {types=mempty, terms=mempty, ctors=mempty}
 
 difference :: Ord v => SlurpComponent v -> SlurpComponent v -> SlurpComponent v
-difference c1 c2 = SlurpComponent {types=types', terms=terms'} where
+difference c1 c2 = SlurpComponent {types=types', terms=terms', ctors=ctors'} where
   types' = types c1 `Set.difference` types c2
   terms' = terms c1 `Set.difference` terms c2
+  ctors' = ctors c1 `Set.difference` ctors c2
 
 intersection :: Ord v => SlurpComponent v -> SlurpComponent v -> SlurpComponent v
-intersection c1 c2 = SlurpComponent {types=types', terms=terms'} where
+intersection c1 c2 = SlurpComponent {types=types', terms=terms', ctors=ctors'} where
   types' = types c1 `Set.intersection` types c2
   terms' = terms c1 `Set.intersection` terms c2
+  ctors' = ctors c1 `Set.intersection` ctors c2
 
 instance Ord v => Semigroup (SlurpComponent v) where (<>) = mappend
 instance Ord v => Monoid (SlurpComponent v) where
-  mempty = SlurpComponent {types=mempty, terms=mempty}
+  mempty = SlurpComponent {types=mempty, terms=mempty, ctors=mempty}
   c1 `mappend` c2 = SlurpComponent { types = types c1 <> types c2
                                    , terms = terms c1 <> terms c2
+                                   , ctors = ctors c1 <> ctors c2
                                    }
 
 
@@ -47,10 +50,13 @@ instance Ord v => Monoid (SlurpComponent v) where
 -- is what you want.
 closeWithDependencies :: forall v a. Ord v
   => TypecheckedUnisonFile v a -> SlurpComponent v -> SlurpComponent v
-closeWithDependencies uf inputs = seenDefns where
-  seenDefns = foldl' termDeps (SlurpComponent {terms=mempty, types=seenTypes}) (terms inputs)
+closeWithDependencies uf inputs = seenDefns{ctors=constructorDeps} where
+  seenDefns = foldl' termDeps (SlurpComponent {terms=mempty, types=seenTypes, ctors=mempty}) (terms inputs)
   seenTypes = foldl' typeDeps mempty (types inputs)
 
+  constructorDeps :: Set v
+  constructorDeps = UF.constructorsForTypeVars seenTypes uf
+
   termDeps :: SlurpComponent v -> v -> SlurpComponent v
   termDeps seen v | Set.member v (terms seen) = seen
   termDeps seen v = fromMaybe seen $ do
@@ -89,7 +95,7 @@ closeWithDependencies uf inputs = seenDefns where
   invert m = Map.fromList (swap <$> Map.toList m)
 
 fromTypes :: Ord v => Set v -> SlurpComponent v
-fromTypes vs = SlurpComponent {terms = mempty, types = vs}
+fromTypes vs = SlurpComponent {terms = mempty, types = vs, ctors=mempty}
 
 fromTerms :: Ord v => Set v -> SlurpComponent v
-fromTerms vs = SlurpComponent {terms = vs, types = mempty}
+fromTerms vs = SlurpComponent {terms = vs, types = mempty, ctors=mempty}

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

@@ -8,7 +8,6 @@ module Unison.Codebase.Editor.SlurpResult where
 
 import Unison.Prelude
 
-import Control.Lens ((^.))
 import Unison.Codebase.Editor.SlurpComponent (SlurpComponent(..))
 import Unison.Name ( Name )
 import Unison.Parser.Ann ( Ann )
@@ -16,19 +15,13 @@ import Unison.Var (Var)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Unison.Codebase.Editor.SlurpComponent as SC
-import qualified Unison.ConstructorReference as ConstructorReference
 import qualified Unison.DeclPrinter as DeclPrinter
 import qualified Unison.HashQualified as HQ
-import qualified Unison.Name as Name
-import qualified Unison.Names as Names
 import qualified Unison.PrettyPrintEnv as PPE
-import qualified Unison.Referent as Referent
 import qualified Unison.TypePrinter as TP
 import qualified Unison.UnisonFile as UF
-import qualified Unison.UnisonFile.Names as UF
 import qualified Unison.Util.Monoid as Monoid
 import qualified Unison.Util.Pretty as P
-import qualified Unison.Util.Relation as R
 import qualified Unison.Var as Var
 
 -- `oldRefNames` are the previously existing names for the old reference
@@ -72,16 +65,6 @@ data SlurpResult v = SlurpResult {
   , defsWithBlockedDependencies :: SlurpComponent v
   } deriving (Show)
 
--- Returns the set of constructor names for type names in the given `Set`.
-constructorsFor :: Var v => Set v -> UF.TypecheckedUnisonFile v a -> Set v
-constructorsFor types uf = let
-  names = UF.typecheckedToNames uf
-  typesRefs = Set.unions $ Names.typesNamed names . Name.unsafeFromVar <$> toList types
-  ctorNames = R.filterRan isOkCtor (Names.terms names)
-  isOkCtor (Referent.Con r _) | Set.member (r ^. ConstructorReference.reference_) typesRefs = True
-  isOkCtor _ = False
-  in Set.map Name.toVar $ R.dom ctorNames
-
 isNonempty :: Ord v => SlurpResult v -> Bool
 isNonempty s = Monoid.nonEmpty (adds s) || Monoid.nonEmpty (updates s)