module Unison.Codebase.Branch.Type
  ( NamespaceHash,
    head,
    headHash,
    namespaceHash,
    Branch (..),
    Branch0 (asUnconflicted),
    UnconflictedBranchView (..),
    branch0,
    terms_,
    types_,
    children_,
    nonEmptyChildren,
    history_,
    edits_,
    isEmpty0,
    deepTerms,
    deepTypes,
    deepPaths,
    deleteLibdeps,
    Star,
    UnwrappedBranch,
  )
where

import Control.Lens hiding (children, cons, transform, uncons)
import Control.Monad.State (State)
import Control.Monad.State qualified as State
import Data.Bitraversable (bitraverse)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as Set.NonEmpty
import U.Codebase.HashTags (BranchHash (..), CausalHash, PatchHash (..))
import Unison.Codebase.Causal.Type (Causal)
import Unison.Codebase.Causal.Type qualified as Causal
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch (Patch)
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Hash (HashFor (..))
import Unison.Hash qualified as Hash
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Prelude hiding (empty)
import Unison.Reference (TypeReference)
import Unison.Referent (Referent)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Conflicted (Conflicted (..))
import Unison.Util.Defn (Defn (..), DefnF)
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Nametree (Nametree, unflattenNametrees)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R
import Unison.Util.Relation qualified as Relation
import Unison.Util.Star2 qualified as Star2
import Prelude hiding (head, read, subtract)

-- | A node in the Unison namespace hierarchy
-- along with its history.
newtype Branch m = Branch {forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history :: UnwrappedBranch m}
  deriving (Branch m -> Branch m -> Bool
(Branch m -> Branch m -> Bool)
-> (Branch m -> Branch m -> Bool) -> Eq (Branch m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). Branch m -> Branch m -> Bool
$c== :: forall (m :: * -> *). Branch m -> Branch m -> Bool
== :: Branch m -> Branch m -> Bool
$c/= :: forall (m :: * -> *). Branch m -> Branch m -> Bool
/= :: Branch m -> Branch m -> Bool
Eq, Eq (Branch m)
Eq (Branch m) =>
(Branch m -> Branch m -> Ordering)
-> (Branch m -> Branch m -> Bool)
-> (Branch m -> Branch m -> Bool)
-> (Branch m -> Branch m -> Bool)
-> (Branch m -> Branch m -> Bool)
-> (Branch m -> Branch m -> Branch m)
-> (Branch m -> Branch m -> Branch m)
-> Ord (Branch m)
Branch m -> Branch m -> Bool
Branch m -> Branch m -> Ordering
Branch m -> Branch m -> Branch m
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
forall (m :: * -> *). Eq (Branch m)
forall (m :: * -> *). Branch m -> Branch m -> Bool
forall (m :: * -> *). Branch m -> Branch m -> Ordering
forall (m :: * -> *). Branch m -> Branch m -> Branch m
$ccompare :: forall (m :: * -> *). Branch m -> Branch m -> Ordering
compare :: Branch m -> Branch m -> Ordering
$c< :: forall (m :: * -> *). Branch m -> Branch m -> Bool
< :: Branch m -> Branch m -> Bool
$c<= :: forall (m :: * -> *). Branch m -> Branch m -> Bool
<= :: Branch m -> Branch m -> Bool
$c> :: forall (m :: * -> *). Branch m -> Branch m -> Bool
> :: Branch m -> Branch m -> Bool
$c>= :: forall (m :: * -> *). Branch m -> Branch m -> Bool
>= :: Branch m -> Branch m -> Bool
$cmax :: forall (m :: * -> *). Branch m -> Branch m -> Branch m
max :: Branch m -> Branch m -> Branch m
$cmin :: forall (m :: * -> *). Branch m -> Branch m -> Branch m
min :: Branch m -> Branch m -> Branch m
Ord)

type UnwrappedBranch m = Causal m (Branch0 m)

-- | A Hash for a namespace itself, it doesn't incorporate any history.
type NamespaceHash m = Hash.HashFor (Branch0 m)

type Star r n = Metadata.Star r n

head :: Branch m -> Branch0 m
head :: forall (m :: * -> *). Branch m -> Branch0 m
head (Branch UnwrappedBranch m
c) = UnwrappedBranch m -> Branch0 m
forall (m :: * -> *) e. Causal m e -> e
Causal.head UnwrappedBranch m
c

headHash :: Branch m -> CausalHash
headHash :: forall (m :: * -> *). Branch m -> CausalHash
headHash (Branch UnwrappedBranch m
c) = UnwrappedBranch m -> CausalHash
forall (m :: * -> *) e. Causal m e -> CausalHash
Causal.currentHash UnwrappedBranch m
c

namespaceHash :: forall m. Branch m -> BranchHash
namespaceHash :: forall (m :: * -> *). Branch m -> BranchHash
namespaceHash (Branch UnwrappedBranch m
c) = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(HashFor (Branch0 m)) @BranchHash (UnwrappedBranch m -> HashFor (Branch0 m)
forall (m :: * -> *) e. Causal m e -> HashFor e
Causal.valueHash UnwrappedBranch m
c)

-- | A node in the Unison namespace hierarchy.
--
-- '_terms' and '_types' are the declarations at this level.
-- '_children' are the nodes one level below us.
-- '_edits' are the 'Patch's stored at this node in the code.
--
-- The remaining fields are derived from the four above.
-- None of the record fields are exported to avoid accidental tweaking without updating the
-- associated derived fields.
--
-- Use either the lensy accessors or the field getters.
data Branch0 m = Branch0
  { forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms :: Star Referent NameSegment,
    forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types :: Star TypeReference NameSegment,
    -- | Note the 'Branch' here, not 'Branch0'.
    -- Every level in the tree has a history.
    forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children :: Map NameSegment (Branch m),
    forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits :: Map NameSegment (PatchHash, m Patch),
    -- | True if a branch and its children have no definitions or edits in them.
    -- (Computed recursively, and small enough to justify storing here to avoid computing more than once.)
    forall (m :: * -> *). Branch0 m -> Bool
_isEmpty0 :: Bool,
    -- names for this branch and its children
    forall (m :: * -> *). Branch0 m -> Relation Referent Name
_deepTerms :: Relation Referent Name,
    forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
_deepTypes :: Relation TypeReference Name,
    forall (m :: * -> *). Branch0 m -> Set Path
_deepPaths :: Set Path,
    forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedBranchView
asUnconflicted ::
      Either
        ( Defn
            (Conflicted Name Referent)
            (Conflicted Name TypeReference)
        )
        UnconflictedBranchView
  }

instance Eq (Branch0 m) where
  Branch0 m
a == :: Branch0 m -> Branch0 m -> Bool
== Branch0 m
b =
    Branch0 m -> Star Referent NameSegment
forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms Branch0 m
a Star Referent NameSegment -> Star Referent NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== Branch0 m -> Star Referent NameSegment
forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms Branch0 m
b
      Bool -> Bool -> Bool
&& Branch0 m -> Star TypeReference NameSegment
forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types Branch0 m
a Star TypeReference NameSegment
-> Star TypeReference NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== Branch0 m -> Star TypeReference NameSegment
forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types Branch0 m
b
      Bool -> Bool -> Bool
&& Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children Branch0 m
a Map NameSegment (Branch m) -> Map NameSegment (Branch m) -> Bool
forall a. Eq a => a -> a -> Bool
== Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children Branch0 m
b
      Bool -> Bool -> Bool
&& (((PatchHash, m Patch) -> PatchHash)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment PatchHash
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst (Map NameSegment (PatchHash, m Patch) -> Map NameSegment PatchHash)
-> (Branch0 m -> Map NameSegment (PatchHash, m Patch))
-> Branch0 m
-> Map NameSegment PatchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Map NameSegment (PatchHash, m Patch)
forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits) Branch0 m
a Map NameSegment PatchHash -> Map NameSegment PatchHash -> Bool
forall a. Eq a => a -> a -> Bool
== (((PatchHash, m Patch) -> PatchHash)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment PatchHash
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst (Map NameSegment (PatchHash, m Patch) -> Map NameSegment PatchHash)
-> (Branch0 m -> Map NameSegment (PatchHash, m Patch))
-> Branch0 m
-> Map NameSegment PatchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Map NameSegment (PatchHash, m Patch)
forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits) Branch0 m
b

-- | A view of a branch's definition (everything outside of `lib`) that is unconflicted: each name refers to one thing.
-- The data contained within is all just different expressions of the same contents, for various use cases. The
-- intention is to use laziness to avoid recomputing data structures whenever possible.
data UnconflictedBranchView = UnconflictedBranchView
  { UnconflictedBranchView
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name),
    UnconflictedBranchView
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree :: Nametree (DefnsF (Map NameSegment) Referent TypeReference),
    UnconflictedBranchView -> Names
names :: Names
  }

makeUnconflictedBranchView :: DefnsF (Map Name) Referent TypeReference -> UnconflictedBranchView
makeUnconflictedBranchView :: DefnsF (Map Name) Referent TypeReference -> UnconflictedBranchView
makeUnconflictedBranchView DefnsF (Map Name) Referent TypeReference
defns0 =
  UnconflictedBranchView
    { $sel:defns:UnconflictedBranchView :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns = (Map Name Referent -> BiMultimap Referent Name)
-> (Map Name TypeReference -> BiMultimap TypeReference Name)
-> DefnsF (Map Name) Referent TypeReference
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name Referent -> BiMultimap Referent Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange Map Name TypeReference -> BiMultimap TypeReference Name
forall a b. (Ord a, Ord b) => Map b a -> BiMultimap a b
BiMultimap.fromRange DefnsF (Map Name) Referent TypeReference
defns0,
      $sel:nametree:UnconflictedBranchView :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree = DefnsF (Map Name) Referent TypeReference
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall term typ.
(Ord term, Ord typ) =>
DefnsF (Map Name) term typ
-> Nametree (DefnsF (Map NameSegment) term typ)
unflattenNametrees DefnsF (Map Name) Referent TypeReference
defns0,
      $sel:names:UnconflictedBranchView :: Names
names = DefnsF (Map Name) Referent TypeReference -> Names
Names.fromUnconflicted DefnsF (Map Name) Referent TypeReference
defns0
    }

history_ :: Iso' (Branch m) (UnwrappedBranch m)
history_ :: forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UnwrappedBranch m) (f (UnwrappedBranch m))
-> p (Branch m) (f (Branch m))
history_ = (Branch m -> UnwrappedBranch m)
-> (UnwrappedBranch m -> Branch m)
-> Iso
     (Branch m) (Branch m) (UnwrappedBranch m) (UnwrappedBranch m)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch

edits_ :: Lens' (Branch0 m) (Map NameSegment (PatchHash, m Patch))
edits_ :: forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
edits_ =
  (Branch0 m -> Map NameSegment (PatchHash, m Patch))
-> (Branch0 m -> Map NameSegment (PatchHash, m Patch) -> Branch0 m)
-> Lens
     (Branch0 m)
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
     (Map NameSegment (PatchHash, m Patch))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    Branch0 m -> Map NameSegment (PatchHash, m Patch)
forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits
    ( \Branch0 m
b0 Map NameSegment (PatchHash, m Patch)
e ->
        Branch0 m
b0 {_edits = e}
          Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveIsEmpty
    )

terms_ :: Lens' (Branch0 m) (Star Referent NameSegment)
terms_ :: forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_ =
  (Branch0 m -> Star Referent NameSegment)
-> (Branch0 m -> Star Referent NameSegment -> Branch0 m)
-> Lens
     (Branch0 m)
     (Branch0 m)
     (Star Referent NameSegment)
     (Star Referent NameSegment)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    Branch0 m -> Star Referent NameSegment
forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms
    \Branch0 m
branch Star Referent NameSegment
terms ->
      Branch0 m
branch {_terms = terms}
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTerms
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveAsUnconflicted
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveIsEmpty

types_ :: Lens' (Branch0 m) (Star TypeReference NameSegment)
types_ :: forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_ =
  (Branch0 m -> Star TypeReference NameSegment)
-> (Branch0 m -> Star TypeReference NameSegment -> Branch0 m)
-> Lens
     (Branch0 m)
     (Branch0 m)
     (Star TypeReference NameSegment)
     (Star TypeReference NameSegment)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    Branch0 m -> Star TypeReference NameSegment
forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types
    \Branch0 m
branch Star TypeReference NameSegment
types ->
      Branch0 m
branch {_types = types}
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTypes
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveAsUnconflicted
        Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveIsEmpty

isEmpty0 :: Branch0 m -> Bool
isEmpty0 :: forall (m :: * -> *). Branch0 m -> Bool
isEmpty0 = Branch0 m -> Bool
forall (m :: * -> *). Branch0 m -> Bool
_isEmpty0

deepTerms :: Branch0 m -> Relation Referent Name
deepTerms :: forall (m :: * -> *). Branch0 m -> Relation Referent Name
deepTerms = Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
_deepTerms

deepTypes :: Branch0 m -> Relation TypeReference Name
deepTypes :: forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
deepTypes = Branch0 m -> Relation TypeReference Name
forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
_deepTypes

deepPaths :: Branch0 m -> Set Path
deepPaths :: forall (m :: * -> *). Branch0 m -> Set Path
deepPaths = Branch0 m -> Set Path
forall (m :: * -> *). Branch0 m -> Set Path
_deepPaths

children_ :: Lens' (Branch0 m) (Map NameSegment (Branch m))
children_ :: forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ = (Branch0 m -> Map NameSegment (Branch m))
-> (Branch0 m -> Map NameSegment (Branch m) -> Branch0 m)
-> Lens
     (Branch0 m)
     (Branch0 m)
     (Map NameSegment (Branch m))
     (Map NameSegment (Branch m))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children (\Branch0 {Star Referent NameSegment
_terms :: forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms :: Star Referent NameSegment
_terms, Star TypeReference NameSegment
_types :: forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types :: Star TypeReference NameSegment
_types, Map NameSegment (PatchHash, m Patch)
_edits :: forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits :: Map NameSegment (PatchHash, m Patch)
_edits} Map NameSegment (Branch m)
x -> Star Referent NameSegment
-> Star TypeReference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star TypeReference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0 Star Referent NameSegment
_terms Star TypeReference NameSegment
_types Map NameSegment (Branch m)
x Map NameSegment (PatchHash, m Patch)
_edits)

nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m)
nonEmptyChildren :: forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
nonEmptyChildren Branch0 m
b =
  Branch0 m
b
    Branch0 m
-> (Branch0 m -> Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall a b. a -> (a -> b) -> b
& Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children
    Map NameSegment (Branch m)
-> (Map NameSegment (Branch m) -> Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall a b. a -> (a -> b) -> b
& (Branch m -> Bool)
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Branch m -> Bool) -> Branch m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Bool
forall (m :: * -> *). Branch0 m -> Bool
isEmpty0 (Branch0 m -> Bool) -> (Branch m -> Branch0 m) -> Branch m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head)

-- creates a Branch0 from the primary fields and derives the others.
branch0 ::
  forall m.
  Metadata.Star Referent NameSegment ->
  Metadata.Star TypeReference NameSegment ->
  Map NameSegment (Branch m) ->
  Map NameSegment (PatchHash, m Patch) ->
  Branch0 m
branch0 :: forall (m :: * -> *).
Star Referent NameSegment
-> Star TypeReference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0 Star Referent NameSegment
terms Star TypeReference NameSegment
types Map NameSegment (Branch m)
children Map NameSegment (PatchHash, m Patch)
edits =
  Branch0
    { _terms :: Star Referent NameSegment
_terms = Star Referent NameSegment
terms,
      _types :: Star TypeReference NameSegment
_types = Star TypeReference NameSegment
types,
      _children :: Map NameSegment (Branch m)
_children = Map NameSegment (Branch m)
children,
      _edits :: Map NameSegment (PatchHash, m Patch)
_edits = Map NameSegment (PatchHash, m Patch)
edits,
      $sel:_isEmpty0:Branch0 :: Bool
_isEmpty0 = Bool
False,
      -- These are all overwritten immediately
      $sel:_deepTerms:Branch0 :: Relation Referent Name
_deepTerms = Relation Referent Name
forall a b. Relation a b
R.empty,
      $sel:_deepTypes:Branch0 :: Relation TypeReference Name
_deepTypes = Relation TypeReference Name
forall a b. Relation a b
R.empty,
      $sel:_deepPaths:Branch0 :: Set Path
_deepPaths = Set Path
forall a. Set a
Set.empty,
      $sel:asUnconflicted:Branch0 :: Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  UnconflictedBranchView
asUnconflicted = Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  UnconflictedBranchView
forall a. HasCallStack => a
undefined
    }
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTerms
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTypes
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveAsUnconflicted
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepPaths
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deriveIsEmpty

deriveIsEmpty :: Branch0 m -> Branch0 m
deriveIsEmpty :: forall (m :: * -> *). Branch0 m -> Branch0 m
deriveIsEmpty Branch0 m
b0 =
  let isEmpty' :: Bool
isEmpty' =
        Relation Referent NameSegment -> Bool
forall a b. Relation a b -> Bool
R.null (Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1 (Star Referent NameSegment -> Relation Referent NameSegment)
-> Star Referent NameSegment -> Relation Referent NameSegment
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Star Referent NameSegment
forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms Branch0 m
b0)
          Bool -> Bool -> Bool
&& Relation TypeReference NameSegment -> Bool
forall a b. Relation a b -> Bool
R.null (Star TypeReference NameSegment
-> Relation TypeReference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1 (Star TypeReference NameSegment
 -> Relation TypeReference NameSegment)
-> Star TypeReference NameSegment
-> Relation TypeReference NameSegment
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Star TypeReference NameSegment
forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types Branch0 m
b0)
          Bool -> Bool -> Bool
&& Map NameSegment (PatchHash, m Patch) -> Bool
forall k a. Map k a -> Bool
Map.null (Branch0 m -> Map NameSegment (PatchHash, m Patch)
forall (m :: * -> *).
Branch0 m -> Map NameSegment (PatchHash, m Patch)
_edits Branch0 m
b0)
          Bool -> Bool -> Bool
&& (Branch m -> Bool) -> Map NameSegment (Branch m) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Branch0 m -> Bool
forall (m :: * -> *). Branch0 m -> Bool
isEmpty0 (Branch0 m -> Bool) -> (Branch m -> Branch0 m) -> Branch m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head) (Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
_children Branch0 m
b0)
   in Branch0 m
b0 {_isEmpty0 = isEmpty'}

-- | Derive the 'deepTerms' field of a branch.
deriveDeepTerms :: Branch0 m -> Branch0 m
deriveDeepTerms :: forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTerms Branch0 m
branch =
  Branch0 m
branch {_deepTerms = R.fromList (makeDeepTerms branch)}
  where
    makeDeepTerms :: Branch0 m -> [(Referent, Name)]
    makeDeepTerms :: forall (m :: * -> *). Branch0 m -> [(Referent, Name)]
makeDeepTerms Branch0 m
branch = State (Set BranchHash) [(Referent, Name)]
-> Set BranchHash -> [(Referent, Name)]
forall s a. State s a -> s -> a
State.evalState (Seq (DeepChildAcc m)
-> [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
forall (m :: * -> *).
Seq (DeepChildAcc m)
-> [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
go (DeepChildAcc m -> Seq (DeepChildAcc m)
forall a. a -> Seq a
Seq.singleton ([], Int
0, Branch0 m
branch)) [(Referent, Name)]
forall a. Monoid a => a
mempty) Set BranchHash
forall a. Set a
Set.empty
      where
        -- `reversePrefix` might be ["Nat", "base", "lib"], and `b0` the `Nat` sub-namespace.
        -- Then `R.toList` might produce the NameSegment "+", and we put the two together to
        -- construct the name `Name Relative ("+" :| ["Nat","base","lib"])`.
        go ::
          forall m.
          Seq (DeepChildAcc m) ->
          [(Referent, Name)] ->
          DeepState [(Referent, Name)]
        go :: forall (m :: * -> *).
Seq (DeepChildAcc m)
-> [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
go Seq (DeepChildAcc m)
Seq.Empty [(Referent, Name)]
acc = [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
forall a. a -> StateT (Set BranchHash) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Referent, Name)]
acc
        go (e :: DeepChildAcc m
e@([NameSegment]
reversePrefix, Int
_, Branch0 m
b0) Seq.:<| Seq (DeepChildAcc m)
work) [(Referent, Name)]
acc = do
          let terms :: [(Referent, Name)]
              terms :: [(Referent, Name)]
terms =
                ((Referent, NameSegment) -> (Referent, Name))
-> [(Referent, NameSegment)] -> [(Referent, Name)]
forall a b. (a -> b) -> [a] -> [b]
map
                  ((NameSegment -> Name)
-> (Referent, NameSegment) -> (Referent, Name)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (NameSegment -> NonEmpty NameSegment) -> NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [NameSegment]
reversePrefix)))
                  (Relation Referent NameSegment -> [(Referent, NameSegment)]
forall a b. Relation a b -> [(a, b)]
R.toList (Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1 (Branch0 m -> Star Referent NameSegment
forall (m :: * -> *). Branch0 m -> Star Referent NameSegment
_terms Branch0 m
b0)))
          Seq (DeepChildAcc m)
children <- DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
forall (m :: * -> *).
DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
deepChildrenHelper DeepChildAcc m
e
          Seq (DeepChildAcc m)
-> [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
forall (m :: * -> *).
Seq (DeepChildAcc m)
-> [(Referent, Name)] -> State (Set BranchHash) [(Referent, Name)]
go (Seq (DeepChildAcc m)
work Seq (DeepChildAcc m)
-> Seq (DeepChildAcc m) -> Seq (DeepChildAcc m)
forall a. Semigroup a => a -> a -> a
<> Seq (DeepChildAcc m)
children) ([(Referent, Name)]
terms [(Referent, Name)] -> [(Referent, Name)] -> [(Referent, Name)]
forall a. Semigroup a => a -> a -> a
<> [(Referent, Name)]
acc)

-- | Derive the 'deepTypes' field of a branch.
deriveDeepTypes :: forall m. Branch0 m -> Branch0 m
deriveDeepTypes :: forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepTypes Branch0 m
branch =
  Branch0 m
branch {_deepTypes = R.fromList (makeDeepTypes branch)}
  where
    makeDeepTypes :: Branch0 m -> [(TypeReference, Name)]
    makeDeepTypes :: Branch0 m -> [(TypeReference, Name)]
makeDeepTypes Branch0 m
branch = State (Set BranchHash) [(TypeReference, Name)]
-> Set BranchHash -> [(TypeReference, Name)]
forall s a. State s a -> s -> a
State.evalState (Seq (DeepChildAcc m)
-> [(TypeReference, Name)]
-> State (Set BranchHash) [(TypeReference, Name)]
go (DeepChildAcc m -> Seq (DeepChildAcc m)
forall a. a -> Seq a
Seq.singleton ([], Int
0, Branch0 m
branch)) [(TypeReference, Name)]
forall a. Monoid a => a
mempty) Set BranchHash
forall a. Set a
Set.empty
      where
        go ::
          Seq (DeepChildAcc m) ->
          [(TypeReference, Name)] ->
          DeepState [(TypeReference, Name)]
        go :: Seq (DeepChildAcc m)
-> [(TypeReference, Name)]
-> State (Set BranchHash) [(TypeReference, Name)]
go Seq (DeepChildAcc m)
Seq.Empty [(TypeReference, Name)]
acc = [(TypeReference, Name)]
-> State (Set BranchHash) [(TypeReference, Name)]
forall a. a -> StateT (Set BranchHash) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(TypeReference, Name)]
acc
        go (e :: DeepChildAcc m
e@([NameSegment]
reversePrefix, Int
_, Branch0 m
b0) Seq.:<| Seq (DeepChildAcc m)
work) [(TypeReference, Name)]
acc = do
          let types :: [(TypeReference, Name)]
              types :: [(TypeReference, Name)]
types = ((TypeReference, NameSegment) -> (TypeReference, Name))
-> [(TypeReference, NameSegment)] -> [(TypeReference, Name)]
forall a b. (a -> b) -> [a] -> [b]
map ((NameSegment -> Name)
-> (TypeReference, NameSegment) -> (TypeReference, Name)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (NameSegment -> NonEmpty NameSegment) -> NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [NameSegment]
reversePrefix))) (Relation TypeReference NameSegment
-> [(TypeReference, NameSegment)]
forall a b. Relation a b -> [(a, b)]
R.toList (Star TypeReference NameSegment
-> Relation TypeReference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1 (Branch0 m -> Star TypeReference NameSegment
forall (m :: * -> *). Branch0 m -> Star TypeReference NameSegment
_types Branch0 m
b0)))
          Seq (DeepChildAcc m)
children <- DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
forall (m :: * -> *).
DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
deepChildrenHelper DeepChildAcc m
e
          Seq (DeepChildAcc m)
-> [(TypeReference, Name)]
-> State (Set BranchHash) [(TypeReference, Name)]
go (Seq (DeepChildAcc m)
work Seq (DeepChildAcc m)
-> Seq (DeepChildAcc m) -> Seq (DeepChildAcc m)
forall a. Semigroup a => a -> a -> a
<> Seq (DeepChildAcc m)
children) ([(TypeReference, Name)]
types [(TypeReference, Name)]
-> [(TypeReference, Name)] -> [(TypeReference, Name)]
forall a. Semigroup a => a -> a -> a
<> [(TypeReference, Name)]
acc)

-- | Derive the 'asUnconflicted' field of a branch.
deriveAsUnconflicted :: Branch0 m -> Branch0 m
deriveAsUnconflicted :: forall (m :: * -> *). Branch0 m -> Branch0 m
deriveAsUnconflicted Branch0 m
branch =
  Branch0 m
branch {asUnconflicted = makeUnconflictedBranchView <$> narrowDefns defns}
  where
    branchWithoutLibdeps :: Branch0 m
branchWithoutLibdeps = Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
deleteLibdeps Branch0 m
branch
    defns :: DefnsF (Relation Name) Referent TypeReference
defns =
      Defns
        { $sel:terms:Defns :: Relation Name Referent
terms = Relation Referent Name -> Relation Name Referent
forall a b. Relation a b -> Relation b a
Relation.swap (Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
deepTerms Branch0 m
branchWithoutLibdeps),
          $sel:types:Defns :: Relation Name TypeReference
types = Relation TypeReference Name -> Relation Name TypeReference
forall a b. Relation a b -> Relation b a
Relation.swap (Branch0 m -> Relation TypeReference Name
forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
deepTypes Branch0 m
branchWithoutLibdeps)
        }

-- | "Narrow" a namespace that may contain conflicted names, resulting in either a failure (if we find a conflicted
-- name), or the narrowed nametree without conflicted names.
narrowDefns ::
  forall term typ.
  (Ord term, Ord typ) =>
  DefnsF (Relation Name) term typ ->
  Either
    (DefnF (Conflicted Name) term typ)
    (DefnsF (Map Name) term typ)
narrowDefns :: forall term typ.
(Ord term, Ord typ) =>
DefnsF (Relation Name) term typ
-> Either
     (DefnF (Conflicted Name) term typ) (DefnsF (Map Name) term typ)
narrowDefns =
  (Relation Name term
 -> Either (DefnF (Conflicted Name) term typ) (Map Name term))
-> (Relation Name typ
    -> Either (DefnF (Conflicted Name) term typ) (Map Name typ))
-> Defns (Relation Name term) (Relation Name typ)
-> Either
     (DefnF (Conflicted Name) term typ)
     (Defns (Map Name term) (Map Name typ))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
    ((Name -> NESet term -> DefnF (Conflicted Name) term typ)
-> Relation Name term
-> Either (DefnF (Conflicted Name) term typ) (Map Name term)
forall ref x.
Ord ref =>
(Name -> NESet ref -> x)
-> Relation Name ref -> Either x (Map Name ref)
go (\Name
name -> Conflicted Name term -> DefnF (Conflicted Name) term typ
forall term typ. term -> Defn term typ
TermDefn (Conflicted Name term -> DefnF (Conflicted Name) term typ)
-> (NESet term -> Conflicted Name term)
-> NESet term
-> DefnF (Conflicted Name) term typ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NESet term -> Conflicted Name term
forall n a. n -> NESet a -> Conflicted n a
Conflicted Name
name))
    ((Name -> NESet typ -> DefnF (Conflicted Name) term typ)
-> Relation Name typ
-> Either (DefnF (Conflicted Name) term typ) (Map Name typ)
forall ref x.
Ord ref =>
(Name -> NESet ref -> x)
-> Relation Name ref -> Either x (Map Name ref)
go (\Name
name -> Conflicted Name typ -> DefnF (Conflicted Name) term typ
forall term typ. typ -> Defn term typ
TypeDefn (Conflicted Name typ -> DefnF (Conflicted Name) term typ)
-> (NESet typ -> Conflicted Name typ)
-> NESet typ
-> DefnF (Conflicted Name) term typ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NESet typ -> Conflicted Name typ
forall n a. n -> NESet a -> Conflicted n a
Conflicted Name
name))
  where
    go :: forall ref x. (Ord ref) => (Name -> NESet ref -> x) -> Relation Name ref -> Either x (Map Name ref)
    go :: forall ref x.
Ord ref =>
(Name -> NESet ref -> x)
-> Relation Name ref -> Either x (Map Name ref)
go Name -> NESet ref -> x
conflicted =
      (Name -> Set ref -> Either x ref)
-> Map Name (Set ref) -> Either x (Map Name ref)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Name -> Set ref -> Either x ref
unconflicted (Map Name (Set ref) -> Either x (Map Name ref))
-> (Relation Name ref -> Map Name (Set ref))
-> Relation Name ref
-> Either x (Map Name ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name ref -> Map Name (Set ref)
forall a b. Relation a b -> Map a (Set b)
Relation.domain
      where
        unconflicted :: Name -> Set ref -> Either x ref
        unconflicted :: Name -> Set ref -> Either x ref
unconflicted Name
name Set ref
refs0
          | NESet ref -> Int
forall a. NESet a -> Int
Set.NonEmpty.size NESet ref
refs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ref -> Either x ref
forall a b. b -> Either a b
Right (NESet ref -> ref
forall a. NESet a -> a
Set.NonEmpty.findMin NESet ref
refs)
          | Bool
otherwise = x -> Either x ref
forall a b. a -> Either a b
Left (Name -> NESet ref -> x
conflicted Name
name NESet ref
refs)
          where
            refs :: NESet ref
refs = Set ref -> NESet ref
forall a. Set a -> NESet a
Set.NonEmpty.unsafeFromSet Set ref
refs0

-- | Derive the 'deepPaths' field of a branch.
deriveDeepPaths :: forall m. Branch0 m -> Branch0 m
deriveDeepPaths :: forall (m :: * -> *). Branch0 m -> Branch0 m
deriveDeepPaths Branch0 m
branch =
  Branch0 m
branch {_deepPaths = makeDeepPaths branch}
  where
    makeDeepPaths :: Branch0 m -> Set Path
    makeDeepPaths :: Branch0 m -> Set Path
makeDeepPaths Branch0 m
branch = State (Set BranchHash) (Set Path) -> Set BranchHash -> Set Path
forall s a. State s a -> s -> a
State.evalState (Seq (DeepChildAcc m)
-> Set Path -> State (Set BranchHash) (Set Path)
go (DeepChildAcc m -> Seq (DeepChildAcc m)
forall a. a -> Seq a
Seq.singleton ([], Int
0, Branch0 m
branch)) Set Path
forall a. Monoid a => a
mempty) Set BranchHash
forall a. Set a
Set.empty
      where
        go :: Seq (DeepChildAcc m) -> Set Path -> DeepState (Set Path)
        go :: Seq (DeepChildAcc m)
-> Set Path -> State (Set BranchHash) (Set Path)
go Seq (DeepChildAcc m)
Seq.Empty Set Path
acc = Set Path -> State (Set BranchHash) (Set Path)
forall a. a -> StateT (Set BranchHash) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Path
acc
        go (e :: DeepChildAcc m
e@([NameSegment]
reversePrefix, Int
_, Branch0 m
b0) Seq.:<| Seq (DeepChildAcc m)
work) Set Path
acc = do
          let paths :: Set Path
              paths :: Set Path
paths =
                if Branch0 m -> Bool
forall (m :: * -> *). Branch0 m -> Bool
isEmpty0 Branch0 m
b0
                  then Set Path
forall a. Set a
Set.empty
                  else (Path -> Set Path
forall a. a -> Set a
Set.singleton (Path -> Set Path)
-> ([NameSegment] -> Path) -> [NameSegment] -> Set Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Path
Path.fromList ([NameSegment] -> Path)
-> ([NameSegment] -> [NameSegment]) -> [NameSegment] -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse) [NameSegment]
reversePrefix
          Seq (DeepChildAcc m)
children <- DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
forall (m :: * -> *).
DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
deepChildrenHelper DeepChildAcc m
e
          Seq (DeepChildAcc m)
-> Set Path -> State (Set BranchHash) (Set Path)
go (Seq (DeepChildAcc m)
work Seq (DeepChildAcc m)
-> Seq (DeepChildAcc m) -> Seq (DeepChildAcc m)
forall a. Semigroup a => a -> a -> a
<> Seq (DeepChildAcc m)
children) (Set Path
paths Set Path -> Set Path -> Set Path
forall a. Semigroup a => a -> a -> a
<> Set Path
acc)

-- | State used by deepChildrenHelper to determine whether to descend into a child branch.
-- Contains the set of visited namespace hashes.
type DeepState = State (Set BranchHash)

-- | Represents a unit of remaining work in traversing children for computing `deep*`.
-- (reverse prefix to a branch, the number of `lib` segments in the reverse prefix, and the branch itself)
type DeepChildAcc m = ([NameSegment], Int, Branch0 m)

-- | Helper for knowing whether to descend into a child branch or not.
-- Accepts child namespaces with previously unseen hashes, and any nested under 1 or fewer `lib` segments.
deepChildrenHelper :: forall m. DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
deepChildrenHelper :: forall (m :: * -> *).
DeepChildAcc m -> DeepState (Seq (DeepChildAcc m))
deepChildrenHelper ([NameSegment]
reversePrefix, Int
libDepth, Branch0 m
b0) = do
  let go :: (NameSegment, Branch m) -> DeepState (Seq (DeepChildAcc m))
      go :: (NameSegment, Branch m) -> DeepState (Seq (DeepChildAcc m))
go (NameSegment
ns, Branch m
b) = do
        let h :: BranchHash
h = Branch m -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
namespaceHash Branch m
b
        Seq (DeepChildAcc m)
result <- do
          let isShallowDependency :: Bool
isShallowDependency = Int
libDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
          Bool
isUnseenNamespace <- (Set BranchHash -> Bool) -> StateT (Set BranchHash) Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (BranchHash -> Set BranchHash -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember BranchHash
h)
          pure
            if Bool
isShallowDependency Bool -> Bool -> Bool
|| Bool
isUnseenNamespace
              then
                let libDepth' :: Int
libDepth' = if NameSegment
ns NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.libSegment then Int
libDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
libDepth
                 in DeepChildAcc m -> Seq (DeepChildAcc m)
forall a. a -> Seq a
Seq.singleton (NameSegment
ns NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
reversePrefix, Int
libDepth', Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b)
              else Seq (DeepChildAcc m)
forall a. Seq a
Seq.empty
        (Set BranchHash -> Set BranchHash)
-> StateT (Set BranchHash) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (BranchHash -> Set BranchHash -> Set BranchHash
forall a. Ord a => a -> Set a -> Set a
Set.insert BranchHash
h)
        pure Seq (DeepChildAcc m)
result
  ((NameSegment, Branch m) -> DeepState (Seq (DeepChildAcc m)))
-> [(NameSegment, Branch m)] -> DeepState (Seq (DeepChildAcc m))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
Monoid.foldMapM (NameSegment, Branch m) -> DeepState (Seq (DeepChildAcc m))
go (Map NameSegment (Branch m) -> [(NameSegment, Branch m)]
forall k a. Map k a -> [(k, a)]
Map.toList (Branch0 m -> Map NameSegment (Branch m)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
nonEmptyChildren Branch0 m
b0))

-- | @deleteLibdeps branch@ deletes all libdeps from @branch@.
deleteLibdeps :: Branch0 m -> Branch0 m
deleteLibdeps :: forall (m :: * -> *). Branch0 m -> Branch0 m
deleteLibdeps =
  ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
-> (Map NameSegment (Branch m) -> Map NameSegment (Branch m))
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ (NameSegment
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NameSegment
NameSegment.libSegment)