module Unison.Codebase.Editor.Slurp
  ( slurpFile,
  )
where

import Control.Lens
import Data.Foldable qualified as Foldable
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Codebase.Editor.SlurpComponent (SlurpComponent (..))
import Unison.Codebase.Editor.SlurpComponent qualified as SC
import Unison.Codebase.Editor.SlurpResult qualified as SR
import Unison.ConstructorReference qualified as CR
import Unison.DataDeclaration qualified as DD
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.ReferentPrime qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name (toVar, unsafeParseVar)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Map qualified as Map
import Unison.Util.Relation qualified as Rel
import Unison.WatchKind (watchKindShouldBeStoredInDatabase)

-- | Tag a variable as representing a term, type, or constructor
data TaggedVar = TermVar Symbol | TypeVar Symbol | ConstructorVar Symbol
  deriving (TaggedVar -> TaggedVar -> Bool
(TaggedVar -> TaggedVar -> Bool)
-> (TaggedVar -> TaggedVar -> Bool) -> Eq TaggedVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaggedVar -> TaggedVar -> Bool
== :: TaggedVar -> TaggedVar -> Bool
$c/= :: TaggedVar -> TaggedVar -> Bool
/= :: TaggedVar -> TaggedVar -> Bool
Eq, Eq TaggedVar
Eq TaggedVar =>
(TaggedVar -> TaggedVar -> Ordering)
-> (TaggedVar -> TaggedVar -> Bool)
-> (TaggedVar -> TaggedVar -> Bool)
-> (TaggedVar -> TaggedVar -> Bool)
-> (TaggedVar -> TaggedVar -> Bool)
-> (TaggedVar -> TaggedVar -> TaggedVar)
-> (TaggedVar -> TaggedVar -> TaggedVar)
-> Ord TaggedVar
TaggedVar -> TaggedVar -> Bool
TaggedVar -> TaggedVar -> Ordering
TaggedVar -> TaggedVar -> TaggedVar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TaggedVar -> TaggedVar -> Ordering
compare :: TaggedVar -> TaggedVar -> Ordering
$c< :: TaggedVar -> TaggedVar -> Bool
< :: TaggedVar -> TaggedVar -> Bool
$c<= :: TaggedVar -> TaggedVar -> Bool
<= :: TaggedVar -> TaggedVar -> Bool
$c> :: TaggedVar -> TaggedVar -> Bool
> :: TaggedVar -> TaggedVar -> Bool
$c>= :: TaggedVar -> TaggedVar -> Bool
>= :: TaggedVar -> TaggedVar -> Bool
$cmax :: TaggedVar -> TaggedVar -> TaggedVar
max :: TaggedVar -> TaggedVar -> TaggedVar
$cmin :: TaggedVar -> TaggedVar -> TaggedVar
min :: TaggedVar -> TaggedVar -> TaggedVar
Ord, Int -> TaggedVar -> ShowS
[TaggedVar] -> ShowS
TaggedVar -> [Char]
(Int -> TaggedVar -> ShowS)
-> (TaggedVar -> [Char])
-> ([TaggedVar] -> ShowS)
-> Show TaggedVar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaggedVar -> ShowS
showsPrec :: Int -> TaggedVar -> ShowS
$cshow :: TaggedVar -> [Char]
show :: TaggedVar -> [Char]
$cshowList :: [TaggedVar] -> ShowS
showList :: [TaggedVar] -> ShowS
Show)

-- | Extract the var from a TaggedVar
untagged :: TaggedVar -> Symbol
untagged :: TaggedVar -> Symbol
untagged (TermVar Symbol
v) = Symbol
v
untagged (TypeVar Symbol
v) = Symbol
v
untagged (ConstructorVar Symbol
v) = Symbol
v

-- | A definition's status with relation to the codebase.
data DefnStatus
  = -- | A constructor in the scratch file conflicts with a term in the codebase
    CtorTermCollision
  | Duplicated
  | New
  | -- | A term in the scratch file conflicts with a Ctor in the codebase
    TermCtorCollision
  | -- | The name of the term is already in the codebase (maybe more than once, i.e. conflicted)
    Updated
  deriving (DefnStatus -> DefnStatus -> Bool
(DefnStatus -> DefnStatus -> Bool)
-> (DefnStatus -> DefnStatus -> Bool) -> Eq DefnStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefnStatus -> DefnStatus -> Bool
== :: DefnStatus -> DefnStatus -> Bool
$c/= :: DefnStatus -> DefnStatus -> Bool
/= :: DefnStatus -> DefnStatus -> Bool
Eq, Eq DefnStatus
Eq DefnStatus =>
(DefnStatus -> DefnStatus -> Ordering)
-> (DefnStatus -> DefnStatus -> Bool)
-> (DefnStatus -> DefnStatus -> Bool)
-> (DefnStatus -> DefnStatus -> Bool)
-> (DefnStatus -> DefnStatus -> Bool)
-> (DefnStatus -> DefnStatus -> DefnStatus)
-> (DefnStatus -> DefnStatus -> DefnStatus)
-> Ord DefnStatus
DefnStatus -> DefnStatus -> Bool
DefnStatus -> DefnStatus -> Ordering
DefnStatus -> DefnStatus -> DefnStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DefnStatus -> DefnStatus -> Ordering
compare :: DefnStatus -> DefnStatus -> Ordering
$c< :: DefnStatus -> DefnStatus -> Bool
< :: DefnStatus -> DefnStatus -> Bool
$c<= :: DefnStatus -> DefnStatus -> Bool
<= :: DefnStatus -> DefnStatus -> Bool
$c> :: DefnStatus -> DefnStatus -> Bool
> :: DefnStatus -> DefnStatus -> Bool
$c>= :: DefnStatus -> DefnStatus -> Bool
>= :: DefnStatus -> DefnStatus -> Bool
$cmax :: DefnStatus -> DefnStatus -> DefnStatus
max :: DefnStatus -> DefnStatus -> DefnStatus
$cmin :: DefnStatus -> DefnStatus -> DefnStatus
min :: DefnStatus -> DefnStatus -> DefnStatus
Ord, Int -> DefnStatus -> ShowS
[DefnStatus] -> ShowS
DefnStatus -> [Char]
(Int -> DefnStatus -> ShowS)
-> (DefnStatus -> [Char])
-> ([DefnStatus] -> ShowS)
-> Show DefnStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefnStatus -> ShowS
showsPrec :: Int -> DefnStatus -> ShowS
$cshow :: DefnStatus -> [Char]
show :: DefnStatus -> [Char]
$cshowList :: [DefnStatus] -> ShowS
showList :: [DefnStatus] -> ShowS
Show)

-- | A coarser, totally-ordered variant of a defnintion's status, which summarizes its own status and the statuses of
-- all of its transitive dependencies.
--
-- For example, if any transitive dependency of a defnition requires an `update`, then so does the definition itself,
-- even if it's new.
--
-- Note: these must be defined in descending severity order, per @mostSevereDepStatus@!
data DepStatus
  = -- | Part of a term/ctor or ctor/term collision: `update` not ok
    DepCollision
  | -- | Requires an update: `add.run` not ok
    DepNeedsUpdate
  | -- | `update` ok
    DepOk
  deriving stock (DepStatus -> DepStatus -> Bool
(DepStatus -> DepStatus -> Bool)
-> (DepStatus -> DepStatus -> Bool) -> Eq DepStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepStatus -> DepStatus -> Bool
== :: DepStatus -> DepStatus -> Bool
$c/= :: DepStatus -> DepStatus -> Bool
/= :: DepStatus -> DepStatus -> Bool
Eq, Eq DepStatus
Eq DepStatus =>
(DepStatus -> DepStatus -> Ordering)
-> (DepStatus -> DepStatus -> Bool)
-> (DepStatus -> DepStatus -> Bool)
-> (DepStatus -> DepStatus -> Bool)
-> (DepStatus -> DepStatus -> Bool)
-> (DepStatus -> DepStatus -> DepStatus)
-> (DepStatus -> DepStatus -> DepStatus)
-> Ord DepStatus
DepStatus -> DepStatus -> Bool
DepStatus -> DepStatus -> Ordering
DepStatus -> DepStatus -> DepStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DepStatus -> DepStatus -> Ordering
compare :: DepStatus -> DepStatus -> Ordering
$c< :: DepStatus -> DepStatus -> Bool
< :: DepStatus -> DepStatus -> Bool
$c<= :: DepStatus -> DepStatus -> Bool
<= :: DepStatus -> DepStatus -> Bool
$c> :: DepStatus -> DepStatus -> Bool
> :: DepStatus -> DepStatus -> Bool
$c>= :: DepStatus -> DepStatus -> Bool
>= :: DepStatus -> DepStatus -> Bool
$cmax :: DepStatus -> DepStatus -> DepStatus
max :: DepStatus -> DepStatus -> DepStatus
$cmin :: DepStatus -> DepStatus -> DepStatus
min :: DepStatus -> DepStatus -> DepStatus
Ord, Int -> DepStatus -> ShowS
[DepStatus] -> ShowS
DepStatus -> [Char]
(Int -> DepStatus -> ShowS)
-> (DepStatus -> [Char])
-> ([DepStatus] -> ShowS)
-> Show DepStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepStatus -> ShowS
showsPrec :: Int -> DepStatus -> ShowS
$cshow :: DepStatus -> [Char]
show :: DepStatus -> [Char]
$cshowList :: [DepStatus] -> ShowS
showList :: [DepStatus] -> ShowS
Show)

-- | Classify a definition status into a coarser dependency status.
defnStatusToDepStatus :: DefnStatus -> DepStatus
defnStatusToDepStatus :: DefnStatus -> DepStatus
defnStatusToDepStatus = \case
  DefnStatus
CtorTermCollision -> DepStatus
DepCollision
  DefnStatus
Duplicated -> DepStatus
DepOk
  DefnStatus
New -> DepStatus
DepOk
  DefnStatus
TermCtorCollision -> DepStatus
DepCollision
  DefnStatus
Updated -> DepStatus
DepNeedsUpdate

-- | DepCollision more severe than DepNeedsUpdate more severe than DepOk
mostSevereDepStatus :: DepStatus -> DepStatus -> DepStatus
mostSevereDepStatus :: DepStatus -> DepStatus -> DepStatus
mostSevereDepStatus =
  DepStatus -> DepStatus -> DepStatus
forall a. Ord a => a -> a -> a
min

-- | Analyze a file and determine the status of all of its definitions with respect to a set
-- of vars to analyze and an operation you wish to perform.
slurpFile ::
  UF.TypecheckedUnisonFile Symbol Ann ->
  Symbol ->
  Names ->
  SR.SlurpResult
slurpFile :: TypecheckedUnisonFile Symbol Ann -> Symbol -> Names -> SlurpResult
slurpFile TypecheckedUnisonFile Symbol Ann
uf Symbol
requestedVar Names
unalteredCodebaseNames =
  let -- A mapping of all vars in the file to their references.
      -- TypeVars are keyed to Type references
      -- TermVars are keyed to Term references
      -- ConstructorVars are keyed to Constructor references
      varReferences :: Map TaggedVar LD.LabeledDependency
      varReferences :: Map TaggedVar LabeledDependency
varReferences = TypecheckedUnisonFile Symbol Ann -> Map TaggedVar LabeledDependency
forall a.
TypecheckedUnisonFile Symbol a -> Map TaggedVar LabeledDependency
buildVarReferences TypecheckedUnisonFile Symbol Ann
uf
      -- All variables which were either:
      -- 1. specified explicitly by the end-user
      -- 2. An in-file transitive dependency (within the file) of a var specified by the end-user.
      involvedVars :: Set TaggedVar
      involvedVars :: Set TaggedVar
involvedVars = TypecheckedUnisonFile Symbol Ann -> TaggedVar -> Set TaggedVar
forall a.
TypecheckedUnisonFile Symbol a -> TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol Ann
uf (Symbol -> TaggedVar
TermVar Symbol
requestedVar)
      -- The set of names after removing any constructors which would
      -- be removed by the requested operation.
      codebaseNames :: Names
      codebaseNames :: Names
codebaseNames = Names
unalteredCodebaseNames
      -- A mapping of every involved variable to its transitive dependencies.
      -- Dependency here is any type or term referenced within the definition (transitively).
      -- This also includes all Constructors of any type used by a term.
      varDeps :: Map TaggedVar (Set TaggedVar)
      varDeps :: Map TaggedVar (Set TaggedVar)
varDeps = TypecheckedUnisonFile Symbol Ann
-> Set TaggedVar -> Map TaggedVar (Set TaggedVar)
computeVarDeps TypecheckedUnisonFile Symbol Ann
uf Set TaggedVar
involvedVars
      -- Compute the status of each definition on its own.
      -- This doesn't consider the vars dependencies.
      selfStatuses :: Map TaggedVar DefnStatus
      selfStatuses :: Map TaggedVar DefnStatus
selfStatuses = Set TaggedVar
-> Map TaggedVar LabeledDependency
-> Names
-> Map TaggedVar DefnStatus
computeSelfStatuses Set TaggedVar
involvedVars Map TaggedVar LabeledDependency
varReferences Names
codebaseNames
      -- A mapping from each definition's name to the most severe status of it plus its transitive dependencies.
      depStatuses :: Map TaggedVar DepStatus
      depStatuses :: Map TaggedVar DepStatus
depStatuses = Map TaggedVar (Set TaggedVar)
-> Map TaggedVar DefnStatus -> Map TaggedVar DepStatus
forall k.
Ord k =>
Map k (Set k) -> Map k DefnStatus -> Map k DepStatus
computeDepStatuses Map TaggedVar (Set TaggedVar)
varDeps Map TaggedVar DefnStatus
selfStatuses
   in TypecheckedUnisonFile Symbol Ann
-> Symbol
-> Set TaggedVar
-> Names
-> Names
-> Map TaggedVar DefnStatus
-> Map TaggedVar DepStatus
-> SlurpResult
toSlurpResult TypecheckedUnisonFile Symbol Ann
uf Symbol
requestedVar Set TaggedVar
involvedVars Names
fileNames Names
codebaseNames Map TaggedVar DefnStatus
selfStatuses Map TaggedVar DepStatus
depStatuses
  where
    fileNames :: Names
    fileNames :: Names
fileNames = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
uf

-- | Compute a mapping of each definition to its status.
computeSelfStatuses ::
  Set TaggedVar ->
  Map TaggedVar LD.LabeledDependency ->
  Names ->
  Map TaggedVar DefnStatus
computeSelfStatuses :: Set TaggedVar
-> Map TaggedVar LabeledDependency
-> Names
-> Map TaggedVar DefnStatus
computeSelfStatuses Set TaggedVar
vars Map TaggedVar LabeledDependency
varReferences Names
codebaseNames =
  (TaggedVar -> DefnStatus)
-> Set TaggedVar -> Map TaggedVar DefnStatus
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet TaggedVar -> DefnStatus
definitionStatus Set TaggedVar
vars
  where
    definitionStatus :: TaggedVar -> DefnStatus
    definitionStatus :: TaggedVar -> DefnStatus
definitionStatus TaggedVar
tv =
      let ld :: LabeledDependency
ld = case TaggedVar
-> Map TaggedVar LabeledDependency -> Maybe LabeledDependency
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TaggedVar
tv Map TaggedVar LabeledDependency
varReferences of
            Just LabeledDependency
r -> LabeledDependency
r
            Maybe LabeledDependency
Nothing -> [Char] -> LabeledDependency
forall a. HasCallStack => [Char] -> a
error ([Char] -> LabeledDependency) -> [Char] -> LabeledDependency
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected LabeledDependency in map for var: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TaggedVar -> [Char]
forall a. Show a => a -> [Char]
show TaggedVar
tv
          v :: Symbol
v = TaggedVar -> Symbol
untagged TaggedVar
tv
          existingTypesAtName :: Set TypeReference
existingTypesAtName = Names -> Name -> Set TypeReference
Names.typesNamed Names
codebaseNames (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
          existingTermsOrCtorsAtName :: Set Referent
existingTermsOrCtorsAtName = Names -> Name -> Set Referent
Names.termsNamed Names
codebaseNames (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
       in case LabeledDependency
ld of
            LD.TypeReference TypeReference
_typeRef ->
              case Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList Set TypeReference
existingTypesAtName of
                [] -> DefnStatus
New
                [TypeReference
r] | TypeReference -> LabeledDependency
LD.typeRef TypeReference
r LabeledDependency -> LabeledDependency -> Bool
forall a. Eq a => a -> a -> Bool
== LabeledDependency
ld -> DefnStatus
Duplicated
                [TypeReference]
_ -> DefnStatus
Updated
            LD.TermReference {} ->
              case Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
existingTermsOrCtorsAtName of
                [] -> DefnStatus
New
                [Referent]
rs | (Referent -> Bool) -> [Referent] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Referent -> Bool
forall r. Referent' r -> Bool
Referent.isConstructor [Referent]
rs -> DefnStatus
TermCtorCollision
                [Referent
r] | Referent -> LabeledDependency
LD.referent Referent
r LabeledDependency -> LabeledDependency -> Bool
forall a. Eq a => a -> a -> Bool
== LabeledDependency
ld -> DefnStatus
Duplicated
                [Referent]
_ -> DefnStatus
Updated
            LD.ConReference {} ->
              case Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
existingTermsOrCtorsAtName of
                [] -> DefnStatus
New
                [Referent]
rs | (Referent -> Bool) -> [Referent] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Referent -> Bool) -> Referent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Bool
forall r. Referent' r -> Bool
Referent.isConstructor) [Referent]
rs -> DefnStatus
CtorTermCollision
                [Referent
r] | Referent -> LabeledDependency
LD.referent Referent
r LabeledDependency -> LabeledDependency -> Bool
forall a. Eq a => a -> a -> Bool
== LabeledDependency
ld -> DefnStatus
Duplicated
                [Referent]
_ -> DefnStatus
Updated

computeDepStatuses :: (Ord k) => Map k (Set k) -> Map k DefnStatus -> Map k DepStatus
computeDepStatuses :: forall k.
Ord k =>
Map k (Set k) -> Map k DefnStatus -> Map k DepStatus
computeDepStatuses Map k (Set k)
varDeps Map k DefnStatus
selfStatuses =
  Map k DefnStatus
selfStatuses Map k DefnStatus
-> (Map k DefnStatus -> Map k DepStatus) -> Map k DepStatus
forall a b. a -> (a -> b) -> b
& (k -> DefnStatus -> DepStatus)
-> Map k DefnStatus -> Map k DepStatus
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey \k
name DefnStatus
status -> do
    Map k (Set k)
varDeps
      Map k (Set k) -> (Map k (Set k) -> Set k) -> Set k
forall a b. a -> (a -> b) -> b
& Set k -> k -> Map k (Set k) -> Set k
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set k
forall a. Set a
Set.empty k
name
      Set k -> (Set k -> [k]) -> [k]
forall a b. a -> (a -> b) -> b
& Set k -> [k]
forall a. Set a -> [a]
Set.toList
      [k] -> ([k] -> [DepStatus]) -> [DepStatus]
forall a b. a -> (a -> b) -> b
& (k -> Maybe DepStatus) -> [k] -> [DepStatus]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\k
depName -> DefnStatus -> DepStatus
defnStatusToDepStatus (DefnStatus -> DepStatus) -> Maybe DefnStatus -> Maybe DepStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Map k DefnStatus -> Maybe DefnStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
depName Map k DefnStatus
selfStatuses)
      [DepStatus] -> ([DepStatus] -> DepStatus) -> DepStatus
forall a b. a -> (a -> b) -> b
& (DepStatus -> DepStatus -> DepStatus)
-> DepStatus -> [DepStatus] -> DepStatus
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr DepStatus -> DepStatus -> DepStatus
mostSevereDepStatus (DefnStatus -> DepStatus
defnStatusToDepStatus DefnStatus
status)

-- | Compute transitive dependencies for all relevant variables.
computeVarDeps ::
  UF.TypecheckedUnisonFile Symbol Ann ->
  Set TaggedVar ->
  Map TaggedVar (Set TaggedVar)
computeVarDeps :: TypecheckedUnisonFile Symbol Ann
-> Set TaggedVar -> Map TaggedVar (Set TaggedVar)
computeVarDeps TypecheckedUnisonFile Symbol Ann
uf Set TaggedVar
allInvolvedVars =
  Set TaggedVar
allInvolvedVars
    Set TaggedVar -> (Set TaggedVar -> [TaggedVar]) -> [TaggedVar]
forall a b. a -> (a -> b) -> b
& Set TaggedVar -> [TaggedVar]
forall a. Set a -> [a]
Set.toList
    [TaggedVar]
-> ([TaggedVar] -> [(TaggedVar, Set TaggedVar)])
-> [(TaggedVar, Set TaggedVar)]
forall a b. a -> (a -> b) -> b
& (TaggedVar -> (TaggedVar, Set TaggedVar))
-> [TaggedVar] -> [(TaggedVar, Set TaggedVar)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TaggedVar
tv -> (TaggedVar
tv, TaggedVar -> Set TaggedVar -> Set TaggedVar
forall a. Ord a => a -> Set a -> Set a
Set.delete TaggedVar
tv (Set TaggedVar -> Set TaggedVar) -> Set TaggedVar -> Set TaggedVar
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann -> TaggedVar -> Set TaggedVar
forall a.
TypecheckedUnisonFile Symbol a -> TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol Ann
uf TaggedVar
tv))
    [(TaggedVar, Set TaggedVar)]
-> ([(TaggedVar, Set TaggedVar)] -> Map TaggedVar (Set TaggedVar))
-> Map TaggedVar (Set TaggedVar)
forall a b. a -> (a -> b) -> b
& [(TaggedVar, Set TaggedVar)] -> Map TaggedVar (Set TaggedVar)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList

-- | Compute the closure of all vars which the provided var depends on.
-- A type depends on its constructors.
varClosure :: UF.TypecheckedUnisonFile Symbol a -> TaggedVar -> Set TaggedVar
varClosure :: forall a.
TypecheckedUnisonFile Symbol a -> TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol a
uf TaggedVar
var =
  SlurpComponent -> Set TaggedVar
mingleVars (TypecheckedUnisonFile Symbol a -> SlurpComponent -> SlurpComponent
forall a.
TypecheckedUnisonFile Symbol a -> SlurpComponent -> SlurpComponent
SC.closeWithDependencies TypecheckedUnisonFile Symbol a
uf ([TaggedVar] -> SlurpComponent
forall (f :: * -> *). Foldable f => f TaggedVar -> SlurpComponent
partitionVars [TaggedVar
var]))

-- | Collect a relation of term or type var to labelled dependency for all definitions mentioned in a file.
buildVarReferences :: UF.TypecheckedUnisonFile Symbol a -> Map TaggedVar LD.LabeledDependency
buildVarReferences :: forall a.
TypecheckedUnisonFile Symbol a -> Map TaggedVar LabeledDependency
buildVarReferences TypecheckedUnisonFile Symbol a
uf =
  Map TaggedVar LabeledDependency
decls Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Map TaggedVar LabeledDependency
effects Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Map TaggedVar LabeledDependency
terms Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Map TaggedVar LabeledDependency
constructors
  where
    terms :: Map TaggedVar LD.LabeledDependency
    terms :: Map TaggedVar LabeledDependency
terms =
      TypecheckedUnisonFile Symbol a
-> Map
     Symbol
     (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe [Char], Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol a
uf
        -- Filter out non-test watch expressions
        Map
  Symbol
  (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> (Map
      Symbol
      (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
    -> Map
         Symbol
         (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a))
-> Map
     Symbol
     (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall a b. a -> (a -> b) -> b
& ((a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
 -> Bool)
-> Map
     Symbol
     (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> Map
     Symbol
     (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(a
_, TermReferenceId
_, Maybe [Char]
w, Term Symbol a
_, Type Symbol a
_) -> Maybe [Char] -> Bool
watchKindShouldBeStoredInDatabase Maybe [Char]
w)
        Map
  Symbol
  (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> (Map
      Symbol
      (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((a, TermReferenceId, Maybe [Char], Term Symbol a,
     Type Symbol a)
    -> LabeledDependency)
-> Map
     Symbol
     (a, TermReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> Map TaggedVar LabeledDependency
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap
          Symbol -> TaggedVar
TermVar
          (\(a
_, TermReferenceId
refId, Maybe [Char]
_, Term Symbol a
_, Type Symbol a
_) -> TermReferenceId -> LabeledDependency
LD.derivedTerm TermReferenceId
refId)
    decls :: Map TaggedVar LD.LabeledDependency
    decls :: Map TaggedVar LabeledDependency
decls =
      TypecheckedUnisonFile Symbol a
-> Map Symbol (TermReferenceId, DataDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol a
uf
        Map Symbol (TermReferenceId, DataDeclaration Symbol a)
-> (Map Symbol (TermReferenceId, DataDeclaration Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((TermReferenceId, DataDeclaration Symbol a)
    -> LabeledDependency)
-> Map Symbol (TermReferenceId, DataDeclaration Symbol a)
-> Map TaggedVar LabeledDependency
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap
          Symbol -> TaggedVar
TypeVar
          (\(TermReferenceId
refId, DataDeclaration Symbol a
_) -> TermReferenceId -> LabeledDependency
LD.derivedType TermReferenceId
refId)

    effects :: Map TaggedVar LD.LabeledDependency
    effects :: Map TaggedVar LabeledDependency
effects =
      TypecheckedUnisonFile Symbol a
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol a
uf
        Map Symbol (TermReferenceId, EffectDeclaration Symbol a)
-> (Map Symbol (TermReferenceId, EffectDeclaration Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((TermReferenceId, EffectDeclaration Symbol a)
    -> LabeledDependency)
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol a)
-> Map TaggedVar LabeledDependency
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap
          Symbol -> TaggedVar
TypeVar
          (\(TermReferenceId
refId, EffectDeclaration Symbol a
_) -> TermReferenceId -> LabeledDependency
LD.derivedType TermReferenceId
refId)

    constructors :: Map TaggedVar LD.LabeledDependency
    constructors :: Map TaggedVar LabeledDependency
constructors =
      let effectConstructors :: Map TaggedVar LD.LabeledDependency
          effectConstructors :: Map TaggedVar LabeledDependency
effectConstructors = [(TaggedVar, LabeledDependency)] -> Map TaggedVar LabeledDependency
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TaggedVar, LabeledDependency)]
 -> Map TaggedVar LabeledDependency)
-> [(TaggedVar, LabeledDependency)]
-> Map TaggedVar LabeledDependency
forall a b. (a -> b) -> a -> b
$ do
            (Symbol
_, (TypeReference
typeRefId, EffectDeclaration Symbol a
effect)) <- Map Symbol (TypeReference, EffectDeclaration Symbol a)
-> [(Symbol, (TypeReference, EffectDeclaration Symbol a))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol a
-> Map Symbol (TypeReference, EffectDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReference, EffectDeclaration v a)
UF.effectDeclarations' TypecheckedUnisonFile Symbol a
uf)
            let decl :: DataDeclaration Symbol a
decl = EffectDeclaration Symbol a -> DataDeclaration Symbol a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl EffectDeclaration Symbol a
effect
            (ConstructorId
conId, Symbol
constructorV) <- [ConstructorId] -> [Symbol] -> [(ConstructorId, Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip (DataDeclaration Symbol a -> [ConstructorId]
forall v a. DataDeclaration v a -> [ConstructorId]
DD.constructorIds DataDeclaration Symbol a
decl) (DataDeclaration Symbol a -> [Symbol]
forall v a. DataDeclaration v a -> [v]
DD.constructorVars DataDeclaration Symbol a
decl)
            (TaggedVar, LabeledDependency) -> [(TaggedVar, LabeledDependency)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TaggedVar, LabeledDependency)
 -> [(TaggedVar, LabeledDependency)])
-> (TaggedVar, LabeledDependency)
-> [(TaggedVar, LabeledDependency)]
forall a b. (a -> b) -> a -> b
$ (Symbol -> TaggedVar
ConstructorVar Symbol
constructorV, ConstructorReference -> LabeledDependency
LD.effectConstructor (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
CR.ConstructorReference TypeReference
typeRefId ConstructorId
conId))

          dataConstructors :: Map TaggedVar LD.LabeledDependency
          dataConstructors :: Map TaggedVar LabeledDependency
dataConstructors = [(TaggedVar, LabeledDependency)] -> Map TaggedVar LabeledDependency
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TaggedVar, LabeledDependency)]
 -> Map TaggedVar LabeledDependency)
-> [(TaggedVar, LabeledDependency)]
-> Map TaggedVar LabeledDependency
forall a b. (a -> b) -> a -> b
$ do
            (Symbol
_, (TypeReference
typeRefId, DataDeclaration Symbol a
decl)) <- Map Symbol (TypeReference, DataDeclaration Symbol a)
-> [(Symbol, (TypeReference, DataDeclaration Symbol a))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol a
-> Map Symbol (TypeReference, DataDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReference, DataDeclaration v a)
UF.dataDeclarations' TypecheckedUnisonFile Symbol a
uf)
            (ConstructorId
conId, Symbol
constructorV) <- [ConstructorId] -> [Symbol] -> [(ConstructorId, Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip (DataDeclaration Symbol a -> [ConstructorId]
forall v a. DataDeclaration v a -> [ConstructorId]
DD.constructorIds DataDeclaration Symbol a
decl) (DataDeclaration Symbol a -> [Symbol]
forall v a. DataDeclaration v a -> [v]
DD.constructorVars DataDeclaration Symbol a
decl)
            (TaggedVar, LabeledDependency) -> [(TaggedVar, LabeledDependency)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TaggedVar, LabeledDependency)
 -> [(TaggedVar, LabeledDependency)])
-> (TaggedVar, LabeledDependency)
-> [(TaggedVar, LabeledDependency)]
forall a b. (a -> b) -> a -> b
$ (Symbol -> TaggedVar
ConstructorVar Symbol
constructorV, ConstructorReference -> LabeledDependency
LD.dataConstructor (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
CR.ConstructorReference TypeReference
typeRefId ConstructorId
conId))
       in Map TaggedVar LabeledDependency
effectConstructors Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
-> Map TaggedVar LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Map TaggedVar LabeledDependency
dataConstructors

-- A helper type just used by 'toSlurpResult' for partitioning results.
data SlurpingSummary = SlurpingSummary
  { SlurpingSummary -> SlurpComponent
adds :: !SlurpComponent,
    SlurpingSummary -> SlurpComponent
duplicates :: !SlurpComponent,
    SlurpingSummary -> SlurpComponent
updates :: !SlurpComponent,
    SlurpingSummary -> SlurpComponent
termCtorColl :: !SlurpComponent,
    SlurpingSummary -> SlurpComponent
ctorTermColl :: !SlurpComponent,
    SlurpingSummary -> SlurpComponent
blocked :: !SlurpComponent
  }

instance Semigroup SlurpingSummary where
  SlurpingSummary SlurpComponent
a SlurpComponent
b SlurpComponent
c SlurpComponent
d SlurpComponent
e SlurpComponent
f
    <> :: SlurpingSummary -> SlurpingSummary -> SlurpingSummary
<> SlurpingSummary SlurpComponent
a' SlurpComponent
b' SlurpComponent
c' SlurpComponent
d' SlurpComponent
e' SlurpComponent
f' =
      SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpingSummary
SlurpingSummary
        (SlurpComponent
a SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
a')
        (SlurpComponent
b SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
b')
        (SlurpComponent
c SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
c')
        (SlurpComponent
d SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
d')
        (SlurpComponent
e SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
e')
        (SlurpComponent
f SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
f')

instance Monoid SlurpingSummary where
  mempty :: SlurpingSummary
mempty = SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpComponent
-> SlurpingSummary
SlurpingSummary SlurpComponent
forall a. Monoid a => a
mempty SlurpComponent
forall a. Monoid a => a
mempty SlurpComponent
forall a. Monoid a => a
mempty SlurpComponent
forall a. Monoid a => a
mempty SlurpComponent
forall a. Monoid a => a
mempty SlurpComponent
forall a. Monoid a => a
mempty

-- | Convert a 'VarsByStatus' mapping into a 'SR.SlurpResult'
toSlurpResult ::
  UF.TypecheckedUnisonFile Symbol Ann ->
  Symbol ->
  Set TaggedVar ->
  Names ->
  Names ->
  Map TaggedVar DefnStatus ->
  Map TaggedVar DepStatus ->
  SR.SlurpResult
toSlurpResult :: TypecheckedUnisonFile Symbol Ann
-> Symbol
-> Set TaggedVar
-> Names
-> Names
-> Map TaggedVar DefnStatus
-> Map TaggedVar DepStatus
-> SlurpResult
toSlurpResult TypecheckedUnisonFile Symbol Ann
uf Symbol
requestedVar Set TaggedVar
involvedVars Names
fileNames Names
codebaseNames Map TaggedVar DefnStatus
selfStatuses Map TaggedVar DepStatus
depStatuses =
  SR.SlurpResult
    { $sel:originalFile:SlurpResult :: TypecheckedUnisonFile Symbol Ann
SR.originalFile = TypecheckedUnisonFile Symbol Ann
uf,
      $sel:extraDefinitions:SlurpResult :: SlurpComponent
SR.extraDefinitions = Set TaggedVar -> SlurpComponent
forall (f :: * -> *). Foldable f => f TaggedVar -> SlurpComponent
partitionVars (Set TaggedVar -> SlurpComponent)
-> Set TaggedVar -> SlurpComponent
forall a b. (a -> b) -> a -> b
$ TaggedVar -> Set TaggedVar -> Set TaggedVar
forall a. Ord a => a -> Set a -> Set a
Set.delete (Symbol -> TaggedVar
TermVar Symbol
requestedVar) Set TaggedVar
involvedVars,
      $sel:adds:SlurpResult :: SlurpComponent
SR.adds = SlurpComponent
adds,
      $sel:duplicates:SlurpResult :: SlurpComponent
SR.duplicates = SlurpComponent
duplicates,
      $sel:collisions:SlurpResult :: SlurpComponent
SR.collisions = SlurpComponent
updates,
      $sel:termExistingConstructorCollisions:SlurpResult :: Set Symbol
SR.termExistingConstructorCollisions =
        let SlurpComponent {Set Symbol
types :: Set Symbol
$sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types, Set Symbol
terms :: Set Symbol
$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms, Set Symbol
ctors :: Set Symbol
$sel:ctors:SlurpComponent :: SlurpComponent -> Set Symbol
ctors} = SlurpComponent
termCtorColl
         in Set Symbol
types Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
terms Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
ctors,
      $sel:constructorExistingTermCollisions:SlurpResult :: Set Symbol
SR.constructorExistingTermCollisions =
        let SlurpComponent {Set Symbol
$sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types :: Set Symbol
types, Set Symbol
$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms :: Set Symbol
terms, Set Symbol
$sel:ctors:SlurpComponent :: SlurpComponent -> Set Symbol
ctors :: Set Symbol
ctors} = SlurpComponent
ctorTermColl
         in Set Symbol
types Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
terms Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
ctors,
      $sel:termAlias:SlurpResult :: Map Symbol Aliases
SR.termAlias = Map Symbol Aliases
termAliases,
      $sel:typeAlias:SlurpResult :: Map Symbol Aliases
SR.typeAlias = Map Symbol Aliases
typeAliases,
      $sel:defsWithBlockedDependencies:SlurpResult :: SlurpComponent
SR.defsWithBlockedDependencies = SlurpComponent
blocked
    }
  where
    SlurpingSummary {SlurpComponent
$sel:adds:SlurpingSummary :: SlurpingSummary -> SlurpComponent
adds :: SlurpComponent
adds, SlurpComponent
$sel:duplicates:SlurpingSummary :: SlurpingSummary -> SlurpComponent
duplicates :: SlurpComponent
duplicates, SlurpComponent
$sel:updates:SlurpingSummary :: SlurpingSummary -> SlurpComponent
updates :: SlurpComponent
updates, SlurpComponent
$sel:termCtorColl:SlurpingSummary :: SlurpingSummary -> SlurpComponent
termCtorColl :: SlurpComponent
termCtorColl, SlurpComponent
$sel:ctorTermColl:SlurpingSummary :: SlurpingSummary -> SlurpComponent
ctorTermColl :: SlurpComponent
ctorTermColl, SlurpComponent
$sel:blocked:SlurpingSummary :: SlurpingSummary -> SlurpComponent
blocked :: SlurpComponent
blocked} =
      (TaggedVar -> DefnStatus -> SlurpingSummary)
-> Map TaggedVar DefnStatus -> SlurpingSummary
forall m a.
Monoid m =>
(TaggedVar -> a -> m) -> Map TaggedVar a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap TaggedVar -> DefnStatus -> SlurpingSummary
summarize1 Map TaggedVar DefnStatus
selfStatuses

    -- Compute a singleton summary for a single definition, per its own status and the most severe status of its
    -- transitive dependencies.
    summarize1 :: TaggedVar -> DefnStatus -> SlurpingSummary
    summarize1 :: TaggedVar -> DefnStatus -> SlurpingSummary
summarize1 TaggedVar
name = \case
      DefnStatus
CtorTermCollision -> SlurpingSummary
forall a. Monoid a => a
mempty {ctorTermColl = sc}
      DefnStatus
Duplicated -> SlurpingSummary
forall a. Monoid a => a
mempty {duplicates = sc}
      DefnStatus
TermCtorCollision -> SlurpingSummary
forall a. Monoid a => a
mempty {termCtorColl = sc}
      DefnStatus
New ->
        case DepStatus
depStatus of
          DepStatus
DepOk -> SlurpingSummary
forall a. Monoid a => a
mempty {adds = sc}
          DepStatus
DepNeedsUpdate -> SlurpingSummary
forall a. Monoid a => a
mempty {blocked = sc}
          DepStatus
DepCollision -> SlurpingSummary
forall a. Monoid a => a
mempty {blocked = sc}
      DefnStatus
Updated ->
        case DepStatus
depStatus of
          DepStatus
DepOk -> SlurpingSummary
forall a. Monoid a => a
mempty {updates = sc}
          DepStatus
DepNeedsUpdate -> SlurpingSummary
forall a. Monoid a => a
mempty {updates = sc}
          DepStatus
DepCollision -> SlurpingSummary
forall a. Monoid a => a
mempty {blocked = sc}
      where
        sc :: SlurpComponent
        sc :: SlurpComponent
sc =
          TaggedVar -> SlurpComponent
scFromTaggedVar TaggedVar
name

        depStatus :: DepStatus
        depStatus :: DepStatus
depStatus =
          DepStatus -> TaggedVar -> Map TaggedVar DepStatus -> DepStatus
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault DepStatus
DepOk TaggedVar
name Map TaggedVar DepStatus
depStatuses

    scFromTaggedVar :: TaggedVar -> SlurpComponent
    scFromTaggedVar :: TaggedVar -> SlurpComponent
scFromTaggedVar = \case
      TermVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromTerms (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)
      TypeVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromTypes (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)
      ConstructorVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromCtors (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)

    buildAliases ::
      Rel.Relation Name Referent ->
      Rel.Relation Name Referent ->
      Set Symbol ->
      Map Symbol SR.Aliases
    buildAliases :: Relation Name Referent
-> Relation Name Referent -> Set Symbol -> Map Symbol Aliases
buildAliases Relation Name Referent
existingNames Relation Name Referent
namesFromFile Set Symbol
dups =
      [(Symbol, Aliases)] -> Map Symbol Aliases
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ( Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
n,
            if Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
aliasesOfOld
              then Set Name -> Aliases
SR.AddAliases Set Name
aliasesOfNew
              else Set Name -> Set Name -> Aliases
SR.UpdateAliases Set Name
aliasesOfOld Set Name
aliasesOfNew
          )
          | (Name
n, r :: Referent
r@Referent.Ref {}) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
Rel.toList Relation Name Referent
namesFromFile,
            -- All the refs whose names include `n`, and are not `r`
            let refs :: Set Referent
refs = Referent -> Set Referent -> Set Referent
forall a. Ord a => a -> Set a -> Set a
Set.delete Referent
r (Set Referent -> Set Referent) -> Set Referent -> Set Referent
forall a b. (a -> b) -> a -> b
$ Name -> Relation Name Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
Rel.lookupDom Name
n Relation Name Referent
existingNames
                aliasesOfNew :: Set Name
aliasesOfNew =
                  Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.delete Name
n (Set Name -> Set Name) -> Set Name -> Set Name
forall a b. (a -> b) -> a -> b
$
                    Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
Rel.lookupRan Referent
r Relation Name Referent
existingNames
                aliasesOfOld :: Set Name
aliasesOfOld =
                  Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.delete Name
n (Set Name -> Set Name)
-> (Relation Name Referent -> Set Name)
-> Relation Name Referent
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name Referent -> Set Name
forall a b. Relation a b -> Set a
Rel.dom (Relation Name Referent -> Set Name)
-> Relation Name Referent -> Set Name
forall a b. (a -> b) -> a -> b
$
                    Relation Name Referent -> Set Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
Rel.restrictRan Relation Name Referent
existingNames Set Referent
refs,
            Bool -> Bool
not (Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
aliasesOfNew Bool -> Bool -> Bool
&& Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
aliasesOfOld),
            Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
n) Set Symbol
dups
        ]

    termAliases :: Map Symbol SR.Aliases
    termAliases :: Map Symbol Aliases
termAliases =
      Relation Name Referent
-> Relation Name Referent -> Set Symbol -> Map Symbol Aliases
buildAliases
        (Names -> Relation Name Referent
Names.terms Names
codebaseNames)
        (Names -> Relation Name Referent
Names.terms Names
fileNames)
        (SlurpComponent -> Set Symbol
SC.terms SlurpComponent
duplicates)

    typeAliases :: Map Symbol SR.Aliases
    typeAliases :: Map Symbol Aliases
typeAliases =
      Relation Name Referent
-> Relation Name Referent -> Set Symbol -> Map Symbol Aliases
buildAliases
        ((TypeReference -> Referent)
-> Relation Name TypeReference -> Relation Name Referent
forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
Rel.mapRan TypeReference -> Referent
Referent.Ref (Relation Name TypeReference -> Relation Name Referent)
-> Relation Name TypeReference -> Relation Name Referent
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name TypeReference
Names.types Names
codebaseNames)
        ((TypeReference -> Referent)
-> Relation Name TypeReference -> Relation Name Referent
forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
Rel.mapRan TypeReference -> Referent
Referent.Ref (Relation Name TypeReference -> Relation Name Referent)
-> Relation Name TypeReference -> Relation Name Referent
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name TypeReference
Names.types Names
fileNames)
        (SlurpComponent -> Set Symbol
SC.types SlurpComponent
duplicates)

-- | Sort out a set of variables by whether it is a term or type.
partitionVars :: (Foldable f) => f TaggedVar -> SlurpComponent
partitionVars :: forall (f :: * -> *). Foldable f => f TaggedVar -> SlurpComponent
partitionVars =
  (TaggedVar -> SlurpComponent) -> f TaggedVar -> SlurpComponent
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    ( \case
        TypeVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromTypes (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)
        TermVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromTerms (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)
        ConstructorVar Symbol
v -> Set Symbol -> SlurpComponent
SC.fromCtors (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v)
    )

-- | Collapse a SlurpComponent into a tagged set.
mingleVars :: SlurpComponent -> Set TaggedVar
mingleVars :: SlurpComponent -> Set TaggedVar
mingleVars SlurpComponent {Set Symbol
$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms :: Set Symbol
terms, Set Symbol
$sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types :: Set Symbol
types, Set Symbol
$sel:ctors:SlurpComponent :: SlurpComponent -> Set Symbol
ctors :: Set Symbol
ctors} =
  (Symbol -> TaggedVar) -> Set Symbol -> Set TaggedVar
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> TaggedVar
TypeVar Set Symbol
types
    Set TaggedVar -> Set TaggedVar -> Set TaggedVar
forall a. Semigroup a => a -> a -> a
<> (Symbol -> TaggedVar) -> Set Symbol -> Set TaggedVar
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> TaggedVar
TermVar Set Symbol
terms
    Set TaggedVar -> Set TaggedVar -> Set TaggedVar
forall a. Semigroup a => a -> a -> a
<> (Symbol -> TaggedVar) -> Set Symbol -> Set TaggedVar
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> TaggedVar
ConstructorVar Set Symbol
ctors