module Unison.Codebase.Editor.Slurp
  ( SlurpOp (..),
    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 (toText, 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.Util.Set qualified as Set
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind (watchKindShouldBeStoredInDatabase)

-- | The operation which is being performed or checked.
data SlurpOp
  = AddOp
  | UpdateOp
  | -- Run when the user saves the scratch file.
    CheckOp
  deriving (SlurpOp -> SlurpOp -> Bool
(SlurpOp -> SlurpOp -> Bool)
-> (SlurpOp -> SlurpOp -> Bool) -> Eq SlurpOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlurpOp -> SlurpOp -> Bool
== :: SlurpOp -> SlurpOp -> Bool
$c/= :: SlurpOp -> SlurpOp -> Bool
/= :: SlurpOp -> SlurpOp -> Bool
Eq, Int -> SlurpOp -> ShowS
[SlurpOp] -> ShowS
SlurpOp -> [Char]
(Int -> SlurpOp -> ShowS)
-> (SlurpOp -> [Char]) -> ([SlurpOp] -> ShowS) -> Show SlurpOp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlurpOp -> ShowS
showsPrec :: Int -> SlurpOp -> ShowS
$cshow :: SlurpOp -> [Char]
show :: SlurpOp -> [Char]
$cshowList :: [SlurpOp] -> ShowS
showList :: [SlurpOp] -> ShowS
Show)

-- | 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 (and thus ok to `add`).
--
-- Note: these must be defined in descending severity order, per @mostSevereDepStatus@!
data DepStatus
  = -- | Part of a term/ctor or ctor/term collision: neither `add` nor `update` ok
    DepCollision
  | -- | Requires an update: `add` not ok, `update` ok
    DepNeedsUpdate
  | -- | `add` or `update` both 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 ->
  Set Symbol ->
  SlurpOp ->
  Names ->
  SR.SlurpResult
slurpFile :: TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
slurpFile TypecheckedUnisonFile Symbol Ann
uf Set Symbol
defsToConsider SlurpOp
slurpOp 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
-> Set Symbol -> Map TaggedVar LabeledDependency -> Set TaggedVar
computeInvolvedVars TypecheckedUnisonFile Symbol Ann
uf Set Symbol
defsToConsider Map TaggedVar LabeledDependency
varReferences
      -- The set of names after removing any constructors which would
      -- be removed by the requested operation.
      codebaseNames :: Names
      codebaseNames :: Names
codebaseNames = TypecheckedUnisonFile Symbol Ann
-> Names -> Set TaggedVar -> SlurpOp -> Names
computeNamesWithDeprecations TypecheckedUnisonFile Symbol Ann
uf Names
unalteredCodebaseNames Set TaggedVar
involvedVars SlurpOp
slurpOp
      -- 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
-> SlurpOp
-> Set Symbol
-> Set TaggedVar
-> Names
-> Names
-> Map TaggedVar DefnStatus
-> Map TaggedVar DepStatus
-> SlurpResult
toSlurpResult TypecheckedUnisonFile Symbol Ann
uf SlurpOp
slurpOp Set Symbol
defsToConsider 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

-- | Return a modified set of names with constructors which would be deprecated by possible
-- updates are removed.
computeNamesWithDeprecations ::
  UF.TypecheckedUnisonFile Symbol Ann ->
  Names ->
  Set TaggedVar ->
  SlurpOp ->
  Names
computeNamesWithDeprecations :: TypecheckedUnisonFile Symbol Ann
-> Names -> Set TaggedVar -> SlurpOp -> Names
computeNamesWithDeprecations TypecheckedUnisonFile Symbol Ann
uf Names
unalteredCodebaseNames Set TaggedVar
involvedVars = \case
  -- If we're 'adding', there won't be any deprecations to worry about.
  SlurpOp
AddOp -> Names
unalteredCodebaseNames
  SlurpOp
CheckOp -> Names
codebaseNames
  SlurpOp
UpdateOp -> Names
codebaseNames
  where
    -- Get the set of all DIRECT definitions in the file which a definition depends on.
    codebaseNames :: Names
    codebaseNames :: Names
codebaseNames =
      (Name -> Bool) -> Names -> Names
Names.filter (Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
deprecatedConstructors) Names
unalteredCodebaseNames
    constructorsUnderConsideration :: Set Name
    constructorsUnderConsideration :: Set Name
constructorsUnderConsideration =
      Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf)
        [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a. Semigroup a => a -> a -> a
<> (((Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
 -> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann)))
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
  -> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann)))
 -> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
 -> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))])
-> ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
    -> (Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
    -> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann)))
-> (EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TypeReferenceId, EffectDeclaration Symbol Ann)
 -> (TypeReferenceId, DataDeclaration Symbol Ann))
-> (Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
-> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TypeReferenceId, EffectDeclaration Symbol Ann)
  -> (TypeReferenceId, DataDeclaration Symbol Ann))
 -> (Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
 -> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann)))
-> ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
    -> (TypeReferenceId, EffectDeclaration Symbol Ann)
    -> (TypeReferenceId, DataDeclaration Symbol Ann))
-> (EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
-> (Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (TypeReferenceId, EffectDeclaration Symbol Ann)
-> (TypeReferenceId, DataDeclaration Symbol Ann)
forall a b.
(a -> b) -> (TypeReferenceId, a) -> (TypeReferenceId, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl (Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf))
        [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> ([(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
    -> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))])
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((Symbol, (TypeReferenceId, DataDeclaration Symbol Ann)) -> Bool)
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Symbol
typeV, (TypeReferenceId, DataDeclaration Symbol Ann)
_) -> TaggedVar -> Set TaggedVar -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Symbol -> TaggedVar
TypeVar Symbol
typeV) Set TaggedVar
involvedVars)
        [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> ([(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
    -> [(Ann, Symbol, Type Symbol Ann)])
-> [(Ann, Symbol, Type Symbol Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))
 -> [(Ann, Symbol, Type Symbol Ann)])
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> [(Ann, Symbol, Type Symbol Ann)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Symbol
_typeV, (TypeReferenceId
_refId, DataDeclaration Symbol Ann
decl)) -> DataDeclaration Symbol Ann -> [(Ann, Symbol, Type Symbol Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors' DataDeclaration Symbol Ann
decl)
        [(Ann, Symbol, Type Symbol Ann)]
-> ([(Ann, Symbol, Type Symbol Ann)] -> [Name]) -> [Name]
forall a b. a -> (a -> b) -> b
& ((Ann, Symbol, Type Symbol Ann) -> Name)
-> [(Ann, Symbol, Type Symbol Ann)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \(Ann
_ann, Symbol
v, Type Symbol Ann
_typ) -> Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v
          )
        [Name] -> ([Name] -> Set Name) -> Set Name
forall a b. a -> (a -> b) -> b
& [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList

    deprecatedConstructors :: Set Name
    deprecatedConstructors :: Set Name
deprecatedConstructors =
      let oldRefsForEditedTypes :: Set TypeReference
oldRefsForEditedTypes = [Set TypeReference] -> Set TypeReference
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set TypeReference] -> Set TypeReference)
-> [Set TypeReference] -> Set TypeReference
forall a b. (a -> b) -> a -> b
$ do
            let declNames :: [Symbol]
declNames = Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> [Symbol]
forall k a. Map k a -> [k]
Map.keys (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf)
            let effectNames :: [Symbol]
effectNames = Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> [Symbol]
forall k a. Map k a -> [k]
Map.keys (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf)
            Symbol
typeName <- [Symbol]
declNames [Symbol] -> [Symbol] -> [Symbol]
forall a. Semigroup a => a -> a -> a
<> [Symbol]
effectNames
            Bool -> [()] -> [()]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> (Set TaggedVar -> Bool) -> Set TaggedVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TaggedVar -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set TaggedVar -> Bool) -> Set TaggedVar -> Bool
forall a b. (a -> b) -> a -> b
$ Set TaggedVar
involvedVars) (Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Symbol -> TaggedVar
TypeVar Symbol
typeName TaggedVar -> Set TaggedVar -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TaggedVar
involvedVars))
            pure $ Names -> Name -> Set TypeReference
Names.typesNamed Names
unalteredCodebaseNames (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
typeName)
          existingConstructorsFromEditedTypes :: Set Name
existingConstructorsFromEditedTypes = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ do
            -- List Monad
            TypeReference
ref <- Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList Set TypeReference
oldRefsForEditedTypes
            (Name
name, Referent
_ref) <- TypeReference -> Names -> [(Name, Referent)]
Names.constructorsForType TypeReference
ref Names
unalteredCodebaseNames
            Name -> [Name]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name
       in -- Compute any constructors which were deleted
          Set Name
existingConstructorsFromEditedTypes Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Name
constructorsUnderConsideration

-- | 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)

-- | Determine all variables which should be considered in analysis.
-- I.e. any variable requested by the user and all of their dependencies,
-- component peers, and component peers of dependencies.
computeInvolvedVars ::
  UF.TypecheckedUnisonFile Symbol Ann ->
  Set Symbol ->
  Map TaggedVar LD.LabeledDependency ->
  Set TaggedVar
computeInvolvedVars :: TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> Map TaggedVar LabeledDependency -> Set TaggedVar
computeInvolvedVars TypecheckedUnisonFile Symbol Ann
uf Set Symbol
defsToConsider Map TaggedVar LabeledDependency
varReferences
  -- If nothing was specified, consider every var in the file.
  | Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
defsToConsider = Map TaggedVar LabeledDependency -> Set TaggedVar
forall k a. Map k a -> Set k
Map.keysSet Map TaggedVar LabeledDependency
varReferences
  | Bool
otherwise = TypecheckedUnisonFile Symbol Ann -> Set TaggedVar -> Set TaggedVar
forall a.
TypecheckedUnisonFile Symbol a -> Set TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol Ann
uf Set TaggedVar
requestedVarsWhichActuallyExist
  where
    -- The user specifies _untyped_ names, which may not even exist in the file.
    -- We need to figure out which vars exist, and what type they are if they do.
    requestedVarsWhichActuallyExist :: Set TaggedVar
    requestedVarsWhichActuallyExist :: Set TaggedVar
requestedVarsWhichActuallyExist = [TaggedVar] -> Set TaggedVar
forall a. Ord a => [a] -> Set a
Set.fromList do
      Symbol
v <- Set Symbol -> [Symbol]
forall a. Set a -> [a]
Set.toList Set Symbol
defsToConsider
      -- We don't know whether each var is a type or term, so we try both.
      -- We don't test ConstructorVar because you can't request to add/update a Constructor in
      -- ucm, you add/update the type instead.
      TaggedVar
tv <- [Symbol -> TaggedVar
TypeVar Symbol
v, Symbol -> TaggedVar
TermVar Symbol
v]
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TaggedVar -> Map TaggedVar LabeledDependency -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member TaggedVar
tv Map TaggedVar LabeledDependency
varReferences)
      pure TaggedVar
tv

-- | 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 -> Set TaggedVar -> Set TaggedVar
forall a.
TypecheckedUnisonFile Symbol a -> Set TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol Ann
uf (TaggedVar -> Set TaggedVar
forall a. a -> Set a
Set.singleton 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 vars depend on.
-- A type depends on its constructors.
varClosure :: UF.TypecheckedUnisonFile Symbol a -> Set TaggedVar -> Set TaggedVar
varClosure :: forall a.
TypecheckedUnisonFile Symbol a -> Set TaggedVar -> Set TaggedVar
varClosure TypecheckedUnisonFile Symbol a
uf (Set TaggedVar -> SlurpComponent
forall (f :: * -> *). Foldable f => f TaggedVar -> SlurpComponent
partitionVars -> SlurpComponent
sc) =
  let deps :: SlurpComponent
deps = TypecheckedUnisonFile Symbol a -> SlurpComponent -> SlurpComponent
forall a.
TypecheckedUnisonFile Symbol a -> SlurpComponent -> SlurpComponent
SC.closeWithDependencies TypecheckedUnisonFile Symbol a
uf SlurpComponent
sc
   in SlurpComponent -> Set TaggedVar
mingleVars SlurpComponent
deps

-- | 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, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TypeReferenceId, Maybe [Char], Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol a
uf
        -- Filter out non-test watch expressions
        Map
  Symbol
  (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> (Map
      Symbol
      (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
    -> Map
         Symbol
         (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a))
-> Map
     Symbol
     (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall a b. a -> (a -> b) -> b
& ((a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
 -> Bool)
-> Map
     Symbol
     (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> Map
     Symbol
     (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(a
_, TypeReferenceId
_, Maybe [Char]
w, Term Symbol a
_, Type Symbol a
_) -> Maybe [Char] -> Bool
watchKindShouldBeStoredInDatabase Maybe [Char]
w)
        Map
  Symbol
  (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
-> (Map
      Symbol
      (a, TypeReferenceId, Maybe [Char], Term Symbol a, Type Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((a, TypeReferenceId, Maybe [Char], Term Symbol a,
     Type Symbol a)
    -> LabeledDependency)
-> Map
     Symbol
     (a, TypeReferenceId, 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
_, TypeReferenceId
refId, Maybe [Char]
_, Term Symbol a
_, Type Symbol a
_) -> TypeReferenceId -> LabeledDependency
LD.derivedTerm TypeReferenceId
refId)
    decls :: Map TaggedVar LD.LabeledDependency
    decls :: Map TaggedVar LabeledDependency
decls =
      TypecheckedUnisonFile Symbol a
-> Map Symbol (TypeReferenceId, DataDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol a
uf
        Map Symbol (TypeReferenceId, DataDeclaration Symbol a)
-> (Map Symbol (TypeReferenceId, DataDeclaration Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((TypeReferenceId, DataDeclaration Symbol a)
    -> LabeledDependency)
-> Map Symbol (TypeReferenceId, 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
          (\(TypeReferenceId
refId, DataDeclaration Symbol a
_) -> TypeReferenceId -> LabeledDependency
LD.derivedType TypeReferenceId
refId)

    effects :: Map TaggedVar LD.LabeledDependency
    effects :: Map TaggedVar LabeledDependency
effects =
      TypecheckedUnisonFile Symbol a
-> Map Symbol (TypeReferenceId, EffectDeclaration Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol a
uf
        Map Symbol (TypeReferenceId, EffectDeclaration Symbol a)
-> (Map Symbol (TypeReferenceId, EffectDeclaration Symbol a)
    -> Map TaggedVar LabeledDependency)
-> Map TaggedVar LabeledDependency
forall a b. a -> (a -> b) -> b
& (Symbol -> TaggedVar)
-> ((TypeReferenceId, EffectDeclaration Symbol a)
    -> LabeledDependency)
-> Map Symbol (TypeReferenceId, 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
          (\(TypeReferenceId
refId, EffectDeclaration Symbol a
_) -> TypeReferenceId -> LabeledDependency
LD.derivedType TypeReferenceId
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 ->
  SlurpOp ->
  Set Symbol ->
  Set TaggedVar ->
  Names ->
  Names ->
  Map TaggedVar DefnStatus ->
  Map TaggedVar DepStatus ->
  SR.SlurpResult
toSlurpResult :: TypecheckedUnisonFile Symbol Ann
-> SlurpOp
-> Set Symbol
-> Set TaggedVar
-> Names
-> Names
-> Map TaggedVar DefnStatus
-> Map TaggedVar DepStatus
-> SlurpResult
toSlurpResult TypecheckedUnisonFile Symbol Ann
uf SlurpOp
op Set Symbol
requestedVars 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 =
        if Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
requestedVars
          then SlurpComponent
forall a. Monoid a => a
mempty
          else
            let desired :: Set TaggedVar
desired =
                  Set Symbol
requestedVars
                    Set Symbol -> (Set Symbol -> Set TaggedVar) -> Set TaggedVar
forall a b. a -> (a -> b) -> b
& (Symbol -> Set TaggedVar) -> Set Symbol -> Set TaggedVar
forall b a. Ord b => (a -> Set b) -> Set a -> Set b
Set.flatMap (\Symbol
v -> [TaggedVar] -> Set TaggedVar
forall a. Ord a => [a] -> Set a
Set.fromList [Symbol -> TaggedVar
TypeVar Symbol
v, Symbol -> TaggedVar
TermVar Symbol
v])
             in Set TaggedVar -> SlurpComponent
forall (f :: * -> *). Foldable f => f TaggedVar -> SlurpComponent
partitionVars (Set TaggedVar -> SlurpComponent)
-> Set TaggedVar -> SlurpComponent
forall a b. (a -> b) -> a -> b
$ Set TaggedVar -> Set TaggedVar -> Set TaggedVar
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set TaggedVar
involvedVars Set TaggedVar
desired,
      $sel:adds:SlurpResult :: SlurpComponent
SR.adds = SlurpComponent
adds,
      $sel:duplicates:SlurpResult :: SlurpComponent
SR.duplicates = SlurpComponent
duplicates,
      $sel:collisions:SlurpResult :: SlurpComponent
SR.collisions = if SlurpOp
op SlurpOp -> SlurpOp -> Bool
forall a. Eq a => a -> a -> Bool
== SlurpOp
AddOp then SlurpComponent
updates else SlurpComponent
forall a. Monoid a => a
mempty,
      $sel:updates:SlurpResult :: SlurpComponent
SR.updates = if SlurpOp
op SlurpOp -> SlurpOp -> Bool
forall a. Eq a => a -> a -> Bool
/= SlurpOp
AddOp then SlurpComponent
updates else SlurpComponent
forall a. Monoid a => a
mempty,
      $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 ->
            case SlurpOp
op of
              SlurpOp
AddOp -> SlurpingSummary
forall a. Monoid a => a
mempty {blocked = sc}
              SlurpOp
CheckOp -> SlurpingSummary
forall a. Monoid a => a
mempty {adds = sc}
              SlurpOp
UpdateOp -> SlurpingSummary
forall a. Monoid a => a
mempty {adds = 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
varFromName 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
varFromName 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)

    varFromName :: (Var v) => Name -> v
    varFromName :: forall v. Var v => Name -> v
varFromName Name
name = Text -> v
forall v. Var v => Text -> v
Var.named (Name -> Text
Name.toText Name
name)

-- | 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