{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Codebase.Branch
  ( -- * Branch types
    Branch (..),
    UnwrappedBranch,
    Branch0,
    Raw,
    Star,
    NamespaceHash,

    -- * Branch construction
    fromUnconflictedDefns,
    fromNametree,
    branch0,
    one,
    cons,
    mergeNode,
    uncons,
    empty,
    empty0,
    discardHistory,
    discardHistory0,
    transform,
    transform0,

    -- * Branch tests
    isEmpty,
    isEmpty0,
    isOne,
    before,
    lca,

    -- * properties
    history_,
    head,
    head_,
    headHash,
    namespaceHash,
    children_,
    nonEmptyChildren,
    namespaceStats,

    -- * step
    step,
    stepManyAt,
    stepManyAtM,
    stepEverywhere,
    batchUpdates,
    batchUpdatesM,
    UpdateStrategy (..),
    addTermName,
    addTypeName,
    deleteTermName,
    annihilateTermName,
    annihilateTypeName,
    deleteTypeName,
    setChildBranch,

    -- ** Children queries
    getAt,
    getAt',
    getAt0,
    modifyAt,
    modifyAtM,
    children0,

    -- *** Libdep manipulations
    libdeps_,
    withoutLib,
    withoutTransitiveLibs,
    deleteLibdep,
    deleteLibdeps,
    setLibdeps,

    -- * Branch terms/types/edits

    -- ** Term/type/edits lenses
    terms_,
    types_,
    edits_,

    -- ** Term/type queries
    deepTerms,
    deepTypes,
    deepPaths,
    deepReferents,
    deepTermReferences,
    deepTermReferenceIds,
    deepTypeReferences,
    deepTypeReferenceIds,
    asUnconflicted,
    UnconflictedBranchView (..),
    consBranchSnapshot,
  )
where

import Control.Lens hiding (children, cons, transform, uncons)
import Data.Map qualified as Map
import Data.Semialign qualified as Align
import Data.These (These (..))
import U.Codebase.Branch.Type (NamespaceStats (..))
import U.Codebase.HashTags (CausalHash)
import Unison.Codebase.Branch.Raw (Raw)
import Unison.Codebase.Branch.Type
  ( Branch (..),
    Branch0 (asUnconflicted),
    NamespaceHash,
    Star,
    UnconflictedBranchView (..),
    UnwrappedBranch,
    branch0,
    children_,
    deepPaths,
    deepTerms,
    deepTypes,
    deleteLibdeps,
    edits_,
    head,
    headHash,
    history_,
    isEmpty0,
    namespaceHash,
    nonEmptyChildren,
    terms_,
    types_,
  )
import Unison.Codebase.Causal (Causal)
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Path (Path)
import Unison.Hashing.V2 qualified as Hashing (ContentAddressable (contentHash))
import Unison.Hashing.V2.Convert qualified as H
import Unison.Name (Name)
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude hiding (empty)
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.Defns (Defns (..), DefnsF, alignDefnsWith)
import Unison.Util.List qualified as List
import Unison.Util.Nametree (Nametree (..), unflattenNametree)
import Unison.Util.Recursion (XNor (Both, Neither), cata, project)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set
import Unison.Util.Star2 (Star2)
import Unison.Util.Star2 qualified as Star2
import Witherable (FilterableWithIndex (imapMaybe))
import Prelude hiding (head, read, subtract)

instance AsEmpty (Branch m) where
  _Empty :: Prism' (Branch m) ()
_Empty = (() -> Branch m) -> (Branch m -> Maybe ()) -> Prism' (Branch m) ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Branch m -> () -> Branch m
forall a b. a -> b -> a
const Branch m
forall (m :: * -> *). Branch m
empty) Branch m -> Maybe ()
forall {m :: * -> *}. Branch m -> Maybe ()
matchEmpty
    where
      matchEmpty :: Branch m -> Maybe ()
matchEmpty Branch m
b0
        | Branch m
b0 Branch m -> Branch m -> Bool
forall a. Eq a => a -> a -> Bool
== Branch m
forall (m :: * -> *). Branch m
empty = () -> Maybe ()
forall a. a -> Maybe a
Just ()
        | Bool
otherwise = Maybe ()
forall a. Maybe a
Nothing

instance Hashing.ContentAddressable (Branch0 m) where
  contentHash :: Branch0 m -> Hash
contentHash = Branch0 m -> Hash
forall (m :: * -> *). Branch0 m -> Hash
H.hashBranch0

fromUnconflictedDefns :: DefnsF (Map Name) Referent TypeReference -> Branch0 m
fromUnconflictedDefns :: forall (m :: * -> *).
DefnsF (Map Name) Referent TypeReference -> Branch0 m
fromUnconflictedDefns =
  -- Unflatten the collection of terms into tree, ditto for types
  (Map Name Referent -> Nametree (Map NameSegment Referent))
-> (Map Name TypeReference
    -> Nametree (Map NameSegment TypeReference))
-> DefnsF (Map Name) Referent TypeReference
-> Defns
     (Nametree (Map NameSegment Referent))
     (Nametree (Map NameSegment TypeReference))
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 -> Nametree (Map NameSegment Referent)
forall a. Ord a => Map Name a -> Nametree (Map NameSegment a)
unflattenNametree Map Name TypeReference -> Nametree (Map NameSegment TypeReference)
forall a. Ord a => Map Name a -> Nametree (Map NameSegment a)
unflattenNametree
    -- Align the tree of terms and tree of types into one tree
    (DefnsF (Map Name) Referent TypeReference
 -> Defns
      (Nametree (Map NameSegment Referent))
      (Nametree (Map NameSegment TypeReference)))
-> (Defns
      (Nametree (Map NameSegment Referent))
      (Nametree (Map NameSegment TypeReference))
    -> Branch0 m)
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 m
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (These (Map NameSegment Referent) (Map NameSegment TypeReference)
 -> DefnsF (Map NameSegment) Referent TypeReference)
-> Defns
     (Nametree (Map NameSegment Referent))
     (Nametree (Map NameSegment TypeReference))
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> Defns (f a) (f b) -> f c
alignDefnsWith These (Map NameSegment Referent) (Map NameSegment TypeReference)
-> DefnsF (Map NameSegment) Referent TypeReference
forall tm ty.
These (Map NameSegment tm) (Map NameSegment ty)
-> DefnsF (Map NameSegment) tm ty
f
    (Defns
   (Nametree (Map NameSegment Referent))
   (Nametree (Map NameSegment TypeReference))
 -> Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> Branch0 m)
-> Defns
     (Nametree (Map NameSegment Referent))
     (Nametree (Map NameSegment TypeReference))
-> Branch0 m
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
forall (m :: * -> *).
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
fromNametree
  where
    f :: These (Map NameSegment tm) (Map NameSegment ty) -> DefnsF (Map NameSegment) tm ty
    f :: forall tm ty.
These (Map NameSegment tm) (Map NameSegment ty)
-> DefnsF (Map NameSegment) tm ty
f = \case
      This Map NameSegment tm
terms -> Defns {Map NameSegment tm
terms :: Map NameSegment tm
$sel:terms:Defns :: Map NameSegment tm
terms, $sel:types:Defns :: Map NameSegment ty
types = Map NameSegment ty
forall k a. Map k a
Map.empty}
      That Map NameSegment ty
types -> Defns {$sel:terms:Defns :: Map NameSegment tm
terms = Map NameSegment tm
forall k a. Map k a
Map.empty, Map NameSegment ty
$sel:types:Defns :: Map NameSegment ty
types :: Map NameSegment ty
types}
      These Map NameSegment tm
terms Map NameSegment ty
types -> Map NameSegment tm
-> Map NameSegment ty -> DefnsF (Map NameSegment) tm ty
forall terms types. terms -> types -> Defns terms types
Defns Map NameSegment tm
terms Map NameSegment ty
types

fromNametree :: Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> Branch0 m
fromNametree :: forall (m :: * -> *).
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
fromNametree Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree =
  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
    (Relation Referent NameSegment -> Star Referent NameSegment
forall ref name metadata.
Relation ref name -> Star2 ref name metadata
rel2star Defns
  (Relation Referent NameSegment)
  (Relation TypeReference NameSegment)
defns.terms)
    (Relation TypeReference NameSegment
-> Star TypeReference NameSegment
forall ref name metadata.
Relation ref name -> Star2 ref name metadata
rel2star Defns
  (Relation Referent NameSegment)
  (Relation TypeReference NameSegment)
defns.types)
    (Branch0 m -> Branch m
forall (m :: * -> *). Branch0 m -> Branch m
one (Branch0 m -> Branch m)
-> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> Branch0 m)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
forall (m :: * -> *).
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
fromNametree (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
 -> Branch m)
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Map NameSegment (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree.children)
    Map NameSegment (PatchHash, m Patch)
forall k a. Map k a
Map.empty
  where
    defns :: Defns (Relation Referent NameSegment) (Relation TypeReference NameSegment)
    defns :: Defns
  (Relation Referent NameSegment)
  (Relation TypeReference NameSegment)
defns =
      (Map NameSegment Referent -> Relation Referent NameSegment)
-> (Map NameSegment TypeReference
    -> Relation TypeReference NameSegment)
-> DefnsF (Map NameSegment) Referent TypeReference
-> Defns
     (Relation Referent NameSegment)
     (Relation TypeReference NameSegment)
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 (Relation NameSegment Referent -> Relation Referent NameSegment
forall a b. Relation a b -> Relation b a
Relation.swap (Relation NameSegment Referent -> Relation Referent NameSegment)
-> (Map NameSegment Referent -> Relation NameSegment Referent)
-> Map NameSegment Referent
-> Relation Referent NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NameSegment Referent -> Relation NameSegment Referent
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap) (Relation NameSegment TypeReference
-> Relation TypeReference NameSegment
forall a b. Relation a b -> Relation b a
Relation.swap (Relation NameSegment TypeReference
 -> Relation TypeReference NameSegment)
-> (Map NameSegment TypeReference
    -> Relation NameSegment TypeReference)
-> Map NameSegment TypeReference
-> Relation TypeReference NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NameSegment TypeReference -> Relation NameSegment TypeReference
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap) Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree.value

    rel2star :: Relation ref name -> Star2 ref name metadata
    rel2star :: forall ref name metadata.
Relation ref name -> Star2 ref name metadata
rel2star Relation ref name
rel =
      Star2.Star2 {$sel:fact:Star2 :: Set ref
fact = Relation ref name -> Set ref
forall a b. Relation a b -> Set a
Relation.dom Relation ref name
rel, $sel:d1:Star2 :: Relation ref name
d1 = Relation ref name
rel, $sel:d2:Star2 :: Relation ref metadata
d2 = Relation ref metadata
forall a b. Relation a b
Relation.empty}

libdeps_ :: Traversal' (Branch0 m) (Map NameSegment (Branch m))
libdeps_ :: forall (m :: * -> *) (f :: * -> *).
Applicative f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
libdeps_ =
  (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
 -> Branch0 m -> f (Branch0 m))
-> ((Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
    -> Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m
-> f (Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NameSegment (Branch m))
-> Traversal'
     (Map NameSegment (Branch m)) (IxValue (Map NameSegment (Branch m)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map NameSegment (Branch m))
NameSegment
NameSegment.libSegment ((Branch m -> f (Branch m))
 -> Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> ((Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
    -> Branch m -> f (Branch m))
-> (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Map NameSegment (Branch m)
-> f (Map NameSegment (Branch m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m))
-> ((Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
    -> Branch0 m -> f (Branch0 m))
-> (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch m
-> f (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_

-- | Remove any lib subtrees reachable within the branch.
-- Note: This DOES affect the hash.
withoutLib :: Branch0 m -> Branch0 m
withoutLib :: forall (m :: * -> *). Branch0 m -> Branch0 m
withoutLib Branch0 m
b =
  Branch0 m
b
    Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch m)
 -> Identity (Map NameSegment (Branch m)))
-> Branch0 m -> Identity (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_
      ((Map NameSegment (Branch m)
  -> Identity (Map NameSegment (Branch m)))
 -> Branch0 m -> Identity (Branch0 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
%~ (NameSegment -> Branch m -> Maybe (Branch m))
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall a b.
(NameSegment -> a -> Maybe b)
-> Map NameSegment a -> Map NameSegment b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe
        ( \NameSegment
nameSegment Branch m
child ->
            if NameSegment
nameSegment NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.libSegment
              then Maybe (Branch m)
forall a. Maybe a
Nothing
              else Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just (Branch m
child Branch m -> (Branch m -> Branch m) -> Branch m
forall a b. a -> (a -> b) -> b
& (Branch0 m -> Identity (Branch0 m))
-> Branch m -> Identity (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> Identity (Branch0 m))
 -> Branch m -> Identity (Branch m))
-> (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
withoutLib)
        )

-- | Remove any transitive libs reachable within the branch.
-- Note: This DOES affect the hash.
withoutTransitiveLibs :: Branch0 m -> Branch0 m
withoutTransitiveLibs :: forall (m :: * -> *). Branch0 m -> Branch0 m
withoutTransitiveLibs Branch0 m
b0 =
  let newChildren :: Map NameSegment (Branch m)
newChildren =
        (Branch0 m
b0 Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 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_)
          Map NameSegment (Branch m)
-> (Map NameSegment (Branch m) -> Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall a b. a -> (a -> b) -> b
& (NameSegment -> Branch m -> Maybe (Branch m))
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall a b.
(NameSegment -> a -> Maybe b)
-> Map NameSegment a -> Map NameSegment b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe
            ( \NameSegment
nameSegment Branch m
child ->
                if NameSegment
nameSegment NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.libSegment
                  then Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just (Branch m
child Branch m -> (Branch m -> Branch m) -> Branch m
forall a b. a -> (a -> b) -> b
& (Branch0 m -> Identity (Branch0 m))
-> Branch m -> Identity (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> Identity (Branch0 m))
 -> Branch m -> Identity (Branch m))
-> (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
withoutLib)
                  else Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just (Branch m
child Branch m -> (Branch m -> Branch m) -> Branch m
forall a b. a -> (a -> b) -> b
& (Branch0 m -> Identity (Branch0 m))
-> Branch m -> Identity (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> Identity (Branch0 m))
 -> Branch m -> Identity (Branch m))
-> (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Branch0 m -> Branch0 m
forall (m :: * -> *). Branch0 m -> Branch0 m
withoutTransitiveLibs)
            )
   in Branch0 m
b0 Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch m)
 -> Identity (Map NameSegment (Branch m)))
-> Branch0 m -> Identity (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m)
  -> Identity (Map NameSegment (Branch m)))
 -> Branch0 m -> Identity (Branch0 m))
-> Map NameSegment (Branch m) -> Branch0 m -> Branch0 m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map NameSegment (Branch m)
newChildren

-- | @deleteLibdep name branch@ deletes the libdep named @name@ from @branch@, if it exists.
deleteLibdep :: NameSegment -> Branch0 m -> Branch0 m
deleteLibdep :: forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
deleteLibdep NameSegment
dep =
  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 :: * -> *).
Applicative f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
libdeps_ (NameSegment
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NameSegment
dep)

-- | @setLibdeps libdeps branch@ sets @branch@'s libdeps to @libdeps@.
setLibdeps :: Branch0 m -> Branch0 m -> Branch0 m
setLibdeps :: forall (m :: * -> *). Branch0 m -> Branch0 m -> Branch0 m
setLibdeps Branch0 m
libdeps =
  NameSegment -> Branch m -> Branch0 m -> Branch0 m
forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
setChildBranch NameSegment
NameSegment.libSegment (Branch0 m -> Branch m
forall (m :: * -> *). Branch0 m -> Branch m
one Branch0 m
libdeps)

deepReferents :: Branch0 m -> Set Referent
deepReferents :: forall (m :: * -> *). Branch0 m -> Set Referent
deepReferents = Relation Referent Name -> Set Referent
forall a b. Relation a b -> Set a
R.dom (Relation Referent Name -> Set Referent)
-> (Branch0 m -> Relation Referent Name)
-> Branch0 m
-> Set Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
deepTerms

deepTermReferences :: Branch0 m -> Set TermReference
deepTermReferences :: forall (m :: * -> *). Branch0 m -> Set TypeReference
deepTermReferences =
  (Referent -> Maybe TypeReference)
-> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TypeReference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Set Referent -> Set TypeReference)
-> (Branch0 m -> Set Referent) -> Branch0 m -> Set TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Set Referent
forall (m :: * -> *). Branch0 m -> Set Referent
deepReferents

deepTermReferenceIds :: Branch0 m -> Set TermReferenceId
deepTermReferenceIds :: forall (m :: * -> *). Branch0 m -> Set TermReferenceId
deepTermReferenceIds =
  (Referent -> Maybe TermReferenceId)
-> Set Referent -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TermReferenceId
Referent.toTermReferenceId (Set Referent -> Set TermReferenceId)
-> (Branch0 m -> Set Referent) -> Branch0 m -> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Set Referent
forall (m :: * -> *). Branch0 m -> Set Referent
deepReferents

deepTypeReferences :: Branch0 m -> Set TypeReference
deepTypeReferences :: forall (m :: * -> *). Branch0 m -> Set TypeReference
deepTypeReferences = Relation TypeReference Name -> Set TypeReference
forall a b. Relation a b -> Set a
R.dom (Relation TypeReference Name -> Set TypeReference)
-> (Branch0 m -> Relation TypeReference Name)
-> Branch0 m
-> Set TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Relation TypeReference Name
forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
deepTypes

deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId
deepTypeReferenceIds :: forall (m :: * -> *). Branch0 m -> Set TermReferenceId
deepTypeReferenceIds =
  (TypeReference -> Maybe TermReferenceId)
-> Set TypeReference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TypeReference -> Maybe TermReferenceId
Reference.toId (Set TypeReference -> Set TermReferenceId)
-> (Branch0 m -> Set TypeReference)
-> Branch0 m
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Set TypeReference
forall (m :: * -> *). Branch0 m -> Set TypeReference
deepTypeReferences

namespaceStats :: Branch0 m -> NamespaceStats
namespaceStats :: forall (m :: * -> *). Branch0 m -> NamespaceStats
namespaceStats Branch0 m
b =
  NamespaceStats
    { $sel:numContainedTerms:NamespaceStats :: Int
numContainedTerms = Relation Referent Name -> Int
forall a b. Relation a b -> Int
Relation.size (Relation Referent Name -> Int) -> Relation Referent Name -> Int
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
deepTerms Branch0 m
b,
      $sel:numContainedTypes:NamespaceStats :: Int
numContainedTypes = Relation TypeReference Name -> Int
forall a b. Relation a b -> Int
Relation.size (Relation TypeReference Name -> Int)
-> Relation TypeReference Name -> Int
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Relation TypeReference Name
forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
deepTypes Branch0 m
b,
      $sel:numContainedPatches:NamespaceStats :: Int
numContainedPatches = Int
0
    }

-- | Update the head of the current causal.
-- This re-hashes the current causal head after modifications.
head_ :: Lens' (Branch m) (Branch0 m)
head_ :: forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ = (UnwrappedBranch m -> f (UnwrappedBranch m))
-> Branch m -> f (Branch m)
forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UnwrappedBranch m) (f (UnwrappedBranch m))
-> p (Branch m) (f (Branch m))
history_ ((UnwrappedBranch m -> f (UnwrappedBranch m))
 -> Branch m -> f (Branch m))
-> ((Branch0 m -> f (Branch0 m))
    -> UnwrappedBranch m -> f (UnwrappedBranch m))
-> (Branch0 m -> f (Branch0 m))
-> Branch m
-> f (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 m -> f (Branch0 m))
-> UnwrappedBranch m -> f (UnwrappedBranch m)
forall e (m :: * -> *).
ContentAddressable e =>
Lens' (Causal m e) e
Lens' (UnwrappedBranch m) (Branch0 m)
Causal.head_

-- | Discards the history of a Branch0's children, recursively
discardHistory0 :: (Applicative m) => Branch0 m -> Branch0 m
discardHistory0 :: forall (m :: * -> *). Applicative m => Branch0 m -> Branch0 m
discardHistory0 = 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_ ((Branch m -> Branch m)
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Branch m -> Branch m
forall {m :: * -> *}. Applicative m => Branch m -> Branch m
tweak)
  where
    tweak :: Branch m -> Branch m
tweak Branch m
b = Branch0 m -> Branch m
forall (m :: * -> *). Branch0 m -> Branch m
one (Branch0 m -> Branch0 m
forall (m :: * -> *). Applicative m => Branch0 m -> Branch0 m
discardHistory0 (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b))

-- | Discards the history of a Branch and its children, recursively
discardHistory :: (Applicative m) => Branch m -> Branch m
discardHistory :: forall {m :: * -> *}. Applicative m => Branch m -> Branch m
discardHistory Branch m
b =
  Branch0 m -> Branch m
forall (m :: * -> *). Branch0 m -> Branch m
one (Branch0 m -> Branch0 m
forall (m :: * -> *). Applicative m => Branch0 m -> Branch0 m
discardHistory0 (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b))

-- | `before b1 b2` is true if `b2` incorporates all of `b1`
before :: (Monad m) => Branch m -> Branch m -> m Bool
before :: forall (m :: * -> *). Monad m => Branch m -> Branch m -> m Bool
before (Branch UnwrappedBranch m
b1) (Branch UnwrappedBranch m
b2) = UnwrappedBranch m -> UnwrappedBranch m -> m Bool
forall (m :: * -> *) e.
Monad m =>
Causal m e -> Causal m e -> m Bool
Causal.before UnwrappedBranch m
b1 UnwrappedBranch m
b2

-- returns `Nothing` if no Branch at `path` or if Branch is empty at `path`
getAt :: Path -> Branch m -> Maybe (Branch m)
getAt :: forall (m :: * -> *). Path -> Branch m -> Maybe (Branch m)
getAt = Algebra (XNor NameSegment) (Branch m -> Maybe (Branch m))
-> Path -> Branch m -> Maybe (Branch m)
forall a. Algebra (XNor NameSegment) a -> Path -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata \case
  XNor NameSegment (Branch m -> Maybe (Branch m))
Neither -> \Branch m
root -> if Branch m -> Bool
forall (m :: * -> *). Branch m -> Bool
isEmpty Branch m
root then Maybe (Branch m)
forall a. Maybe a
Nothing else Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just Branch m
root
  Both NameSegment
seg Branch m -> Maybe (Branch m)
fn -> Branch m -> Maybe (Branch m)
fn (Branch m -> Maybe (Branch m))
-> (Branch m -> Maybe (Branch m)) -> Branch m -> Maybe (Branch m)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (Map NameSegment (Branch m) -> Maybe (Branch m))
-> (Branch m -> Map NameSegment (Branch m))
-> Branch m
-> Maybe (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
-> Branch0 m -> Map NameSegment (Branch m)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map NameSegment (Branch m))
  (Branch0 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_ (Branch0 m -> Map NameSegment (Branch m))
-> (Branch m -> Branch0 m)
-> Branch m
-> Map NameSegment (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head

getAt' :: Path -> Branch m -> Branch m
getAt' :: forall (m :: * -> *). Path -> Branch m -> Branch m
getAt' Path
p Branch m
b = Branch m -> Maybe (Branch m) -> Branch m
forall a. a -> Maybe a -> a
fromMaybe Branch m
forall (m :: * -> *). Branch m
empty (Maybe (Branch m) -> Branch m) -> Maybe (Branch m) -> Branch m
forall a b. (a -> b) -> a -> b
$ Path -> Branch m -> Maybe (Branch m)
forall (m :: * -> *). Path -> Branch m -> Maybe (Branch m)
getAt Path
p Branch m
b

getAt0 :: Path -> Branch0 m -> Branch0 m
getAt0 :: forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
getAt0 = Algebra (XNor NameSegment) (Branch0 m -> Branch0 m)
-> Path -> Branch0 m -> Branch0 m
forall a. Algebra (XNor NameSegment) a -> Path -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata \case
  XNor NameSegment (Branch0 m -> Branch0 m)
Neither -> Branch0 m -> Branch0 m
forall a. a -> a
id
  Both NameSegment
seg Branch0 m -> Branch0 m
fn -> Branch0 m -> Branch0 m
fn (Branch0 m -> Branch0 m)
-> (Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m
-> (Branch m -> Branch0 m) -> Maybe (Branch m) -> Branch0 m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Branch0 m
forall (m :: * -> *). Branch0 m
empty0 Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head (Maybe (Branch m) -> Branch0 m)
-> (Branch0 m -> Maybe (Branch m)) -> Branch0 m -> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (Map NameSegment (Branch m) -> Maybe (Branch m))
-> (Branch0 m -> Map NameSegment (Branch m))
-> Branch0 m
-> Maybe (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
-> Branch0 m -> Map NameSegment (Branch m)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map NameSegment (Branch m))
  (Branch0 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_

empty :: Branch m
empty :: forall (m :: * -> *). Branch m
empty = UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch m -> Branch m) -> UnwrappedBranch m -> Branch m
forall a b. (a -> b) -> a -> b
$ Branch0 m -> UnwrappedBranch m
forall e (m :: * -> *). ContentAddressable e => e -> Causal m e
Causal.one Branch0 m
forall (m :: * -> *). Branch0 m
empty0

one :: Branch0 m -> Branch m
one :: forall (m :: * -> *). Branch0 m -> Branch m
one = UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch m -> Branch m)
-> (Branch0 m -> UnwrappedBranch m) -> Branch0 m -> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> UnwrappedBranch m
forall e (m :: * -> *). ContentAddressable e => e -> Causal m e
Causal.one

empty0 :: Branch0 m
empty0 :: forall (m :: * -> *). Branch0 m
empty0 = 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
forall a. Monoid a => a
mempty Star TypeReference NameSegment
forall a. Monoid a => a
mempty Map NameSegment (Branch m)
forall a. Monoid a => a
mempty Map NameSegment (PatchHash, m Patch)
forall a. Monoid a => a
mempty

-- | Checks whether a branch is empty AND has no history.
isEmpty :: Branch m -> Bool
isEmpty :: forall (m :: * -> *). Branch m -> Bool
isEmpty = (Branch m -> Branch m -> Bool
forall a. Eq a => a -> a -> Bool
== Branch m
forall (m :: * -> *). Branch m
empty)

-- | Perform an update over the current branch and create a new causal step.
step :: (Applicative m) => (Branch0 m -> Branch0 m) -> Branch m -> Branch m
step :: forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
step Branch0 m -> Branch0 m
f = Identity (Branch m) -> Branch m
forall a. Identity a -> a
runIdentity (Identity (Branch m) -> Branch m)
-> (Branch m -> Identity (Branch m)) -> Branch m -> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 m -> Identity (Branch0 m))
-> Branch m -> Identity (Branch m)
forall (n :: * -> *) (m :: * -> *).
(Monad n, Applicative m) =>
(Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
stepM (Branch0 m -> Identity (Branch0 m)
forall a. a -> Identity a
Identity (Branch0 m -> Identity (Branch0 m))
-> (Branch0 m -> Branch0 m) -> Branch0 m -> Identity (Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Branch0 m
f)

-- | Perform an update over the current branch and create a new causal step.
stepM :: (Monad n, Applicative m) => (Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
stepM :: forall (n :: * -> *) (m :: * -> *).
(Monad n, Applicative m) =>
(Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
stepM Branch0 m -> n (Branch0 m)
f = \case
  Branch (Causal.One CausalHash
_h HashFor (Branch0 m)
_eh Branch0 m
e) | Branch0 m
e Branch0 m -> Branch0 m -> Bool
forall a. Eq a => a -> a -> Bool
== Branch0 m
forall (m :: * -> *). Branch0 m
empty0 -> Causal m (Branch0 m) -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (Causal m (Branch0 m) -> Branch m)
-> (Branch0 m -> Causal m (Branch0 m)) -> Branch0 m -> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Causal m (Branch0 m)
forall e (m :: * -> *). ContentAddressable e => e -> Causal m e
Causal.one (Branch0 m -> Branch m) -> n (Branch0 m) -> n (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch0 m -> n (Branch0 m)
f Branch0 m
forall (m :: * -> *). Branch0 m
empty0
  Branch m
b -> LensLike
  (WrappedMonad n)
  (Branch m)
  (Branch m)
  (Causal m (Branch0 m))
  (Causal m (Branch0 m))
-> (Causal m (Branch0 m) -> n (Causal m (Branch0 m)))
-> Branch m
-> n (Branch m)
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike
  (WrappedMonad n)
  (Branch m)
  (Branch m)
  (Causal m (Branch0 m))
  (Causal m (Branch0 m))
forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UnwrappedBranch m) (f (UnwrappedBranch m))
-> p (Branch m) (f (Branch m))
history_ ((Branch0 m -> n (Branch0 m))
-> Causal m (Branch0 m) -> n (Causal m (Branch0 m))
forall (m :: * -> *) (n :: * -> *) e.
(Applicative m, Functor n, Eq e, ContentAddressable e) =>
(e -> n e) -> Causal m e -> n (Causal m e)
Causal.stepDistinctM Branch0 m -> n (Branch0 m)
f) Branch m
b

cons :: (Applicative m) => Branch0 m -> Branch m -> Branch m
cons :: forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
cons = (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
step ((Branch0 m -> Branch0 m) -> Branch m -> Branch m)
-> (Branch0 m -> Branch0 m -> Branch0 m)
-> Branch0 m
-> Branch m
-> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Branch0 m -> Branch0 m
forall a b. a -> b -> a
const

-- | Construct a two-parent merge node.
mergeNode ::
  forall m.
  (Applicative m) =>
  Branch0 m ->
  (CausalHash, m (Branch m)) ->
  (CausalHash, m (Branch m)) ->
  Branch m
mergeNode :: forall (m :: * -> *).
Applicative m =>
Branch0 m
-> (CausalHash, m (Branch m))
-> (CausalHash, m (Branch m))
-> Branch m
mergeNode Branch0 m
child (CausalHash, m (Branch m))
parent1 (CausalHash, m (Branch m))
parent2 =
  UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (Branch0 m
-> Map CausalHash (m (UnwrappedBranch m)) -> UnwrappedBranch m
forall e (m :: * -> *).
ContentAddressable e =>
e -> Map CausalHash (m (Causal m e)) -> Causal m e
Causal.mergeNode Branch0 m
child ([(CausalHash, m (UnwrappedBranch m))]
-> Map CausalHash (m (UnwrappedBranch m))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CausalHash, m (Branch m)) -> (CausalHash, m (UnwrappedBranch m))
forall {f :: * -> *} {a} {m :: * -> *}.
Functor f =>
(a, f (Branch m)) -> (a, f (UnwrappedBranch m))
f (CausalHash, m (Branch m))
parent1, (CausalHash, m (Branch m)) -> (CausalHash, m (UnwrappedBranch m))
forall {f :: * -> *} {a} {m :: * -> *}.
Functor f =>
(a, f (Branch m)) -> (a, f (UnwrappedBranch m))
f (CausalHash, m (Branch m))
parent2]))
  where
    f :: (a, f (Branch m)) -> (a, f (UnwrappedBranch m))
f (a
hash, f (Branch m)
getBranch) =
      (a
hash, Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history (Branch m -> UnwrappedBranch m)
-> f (Branch m) -> f (UnwrappedBranch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Branch m)
getBranch)

isOne :: Branch m -> Bool
isOne :: forall (m :: * -> *). Branch m -> Bool
isOne (Branch Causal.One {}) = Bool
True
isOne Branch m
_ = Bool
False

uncons :: (Applicative m) => Branch m -> m (Maybe (Branch0 m, Branch m))
uncons :: forall (m :: * -> *).
Applicative m =>
Branch m -> m (Maybe (Branch0 m, Branch m))
uncons (Branch UnwrappedBranch m
b) = Maybe (Branch0 m, UnwrappedBranch m) -> Maybe (Branch0 m, Branch m)
go (Maybe (Branch0 m, UnwrappedBranch m)
 -> Maybe (Branch0 m, Branch m))
-> m (Maybe (Branch0 m, UnwrappedBranch m))
-> m (Maybe (Branch0 m, Branch m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnwrappedBranch m -> m (Maybe (Branch0 m, UnwrappedBranch m))
forall (m :: * -> *) e.
Applicative m =>
Causal m e -> m (Maybe (e, Causal m e))
Causal.uncons UnwrappedBranch m
b
  where
    go :: Maybe (Branch0 m, UnwrappedBranch m) -> Maybe (Branch0 m, Branch m)
go = ASetter
  (Maybe (Branch0 m, UnwrappedBranch m))
  (Maybe (Branch0 m, Branch m))
  (UnwrappedBranch m)
  (Branch m)
-> (UnwrappedBranch m -> Branch m)
-> Maybe (Branch0 m, UnwrappedBranch m)
-> Maybe (Branch0 m, Branch m)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Branch0 m, UnwrappedBranch m) -> Identity (Branch0 m, Branch m))
-> Maybe (Branch0 m, UnwrappedBranch m)
-> Identity (Maybe (Branch0 m, Branch m))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Branch0 m, UnwrappedBranch m) -> Identity (Branch0 m, Branch m))
 -> Maybe (Branch0 m, UnwrappedBranch m)
 -> Identity (Maybe (Branch0 m, Branch m)))
-> ((UnwrappedBranch m -> Identity (Branch m))
    -> (Branch0 m, UnwrappedBranch m)
    -> Identity (Branch0 m, Branch m))
-> ASetter
     (Maybe (Branch0 m, UnwrappedBranch m))
     (Maybe (Branch0 m, Branch m))
     (UnwrappedBranch m)
     (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnwrappedBranch m -> Identity (Branch m))
-> (Branch0 m, UnwrappedBranch m) -> Identity (Branch0 m, Branch m)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Branch0 m, UnwrappedBranch m)
  (Branch0 m, Branch m)
  (UnwrappedBranch m)
  (Branch m)
_2) UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch

-- | Run a series of updates at specific locations, aggregating all changes into a single causal step.
-- History is managed according to 'UpdateStrategy'.
stepManyAt ::
  forall m f.
  (Monad m, Foldable f) =>
  f (Path, Branch0 m -> Branch0 m) ->
  Branch m ->
  Branch m
stepManyAt :: forall (m :: * -> *) (f :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch m -> Branch m
stepManyAt f (Path, Branch0 m -> Branch0 m)
actions Branch m
startBranch =
  Identity (Branch m) -> Branch m
forall a. Identity a -> a
runIdentity (Identity (Branch m) -> Branch m)
-> Identity (Branch m) -> Branch m
forall a b. (a -> b) -> a -> b
$ [(Path, Branch0 m -> Identity (Branch0 m))]
-> Branch m -> Identity (Branch m)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
stepManyAtM [(Path, Branch0 m -> Identity (Branch0 m))]
actionsIdentity Branch m
startBranch
  where
    actionsIdentity :: [(Path, Branch0 m -> Identity (Branch0 m))]
    actionsIdentity :: [(Path, Branch0 m -> Identity (Branch0 m))]
actionsIdentity = [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Identity (Branch0 m))]
forall a b. Coercible a b => a -> b
coerce (f (Path, Branch0 m -> Branch0 m)
-> [(Path, Branch0 m -> Branch0 m)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Path, Branch0 m -> Branch0 m)
actions)

data UpdateStrategy
  = -- | Compress all changes into a single causal cons.
    -- The resulting branch will have at most one new causal cons at each branch.
    --
    -- Note that this does NOT allow updates to add histories at children.
    -- E.g. if the root.editme branch has history: A -> B -> C
    -- and you use 'makeSetBranch' to update it to a new branch with history X -> Y -> Z,
    -- CompressHistory will result in a history for root.editme of: A -> B -> C -> Z.
    -- A 'snapshot' of the most recent state of the updated branch is appended to the existing history,
    -- if the new state is equal to the existing state, no new history nodes are appended.
    CompressHistory
  | -- | Preserves any history changes made within the update.
    --
    -- Note that this allows you to clobber the history child branches if you want.
    -- E.g. if the root.editme branch has history: A -> B -> C
    -- and you use 'makeSetBranch' to update it to a new branch with history X -> Y -> Z,
    -- AllowRewritingHistory will result in a history for root.editme of: X -> Y -> Z.
    -- The history of the updated branch is replaced entirely.
    AllowRewritingHistory

-- | Run a series of updates at specific locations.
-- History is managed according to the 'UpdateStrategy'
stepManyAtM ::
  (Monad m, Monad n, Foldable f) =>
  f (Path, Branch0 m -> n (Branch0 m)) ->
  Branch m ->
  n (Branch m)
stepManyAtM :: forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
stepManyAtM f (Path, Branch0 m -> n (Branch0 m))
actions Branch m
startBranch = do
  Branch m
updatedBranch <- Branch m
startBranch Branch m -> (Branch m -> n (Branch m)) -> n (Branch m)
forall a b. a -> (a -> b) -> b
& (Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m))
-> (Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ f (Path, Branch0 m -> n (Branch0 m)) -> Branch0 m -> n (Branch0 m)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch0 m -> n (Branch0 m)
batchUpdatesM f (Path, Branch0 m -> n (Branch0 m))
actions
  pure $ Branch m
updatedBranch Branch m -> Branch m -> Branch m
forall (m :: * -> *). Monad m => Branch m -> Branch m -> Branch m
`consBranchSnapshot` Branch m
startBranch

-- starting at the leaves, apply `f` to every level of the branch.
stepEverywhere ::
  (Applicative m) => (Branch0 m -> Branch0 m) -> (Branch0 m -> Branch0 m)
stepEverywhere :: forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
stepEverywhere Branch0 m -> Branch0 m
f Branch0 m
b0 = Branch0 m -> Branch0 m
f (Branch0 m
b0 Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch m)
 -> Identity (Map NameSegment (Branch m)))
-> Branch0 m -> Identity (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m)
  -> Identity (Map NameSegment (Branch m)))
 -> Branch0 m -> Identity (Branch0 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
%~ Map NameSegment (Branch m) -> Map NameSegment (Branch m)
updates)
  where
    updates :: Map NameSegment (Branch m) -> Map NameSegment (Branch m)
updates = (Branch m -> Branch m)
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
step ((Branch0 m -> Branch0 m) -> Branch m -> Branch m)
-> (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall a b. (a -> b) -> a -> b
$ (Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
stepEverywhere Branch0 m -> Branch0 m
f)

-- Creates a function to fix up the children field._1
-- If the action emptied a child, then remove the mapping,
-- otherwise update it.
-- Todo: Fix this in hashing & serialization instead of here?
getChildBranch :: NameSegment -> Branch0 m -> Branch m
getChildBranch :: forall (m :: * -> *). NameSegment -> Branch0 m -> Branch m
getChildBranch NameSegment
seg Branch0 m
b = Branch m -> Maybe (Branch m) -> Branch m
forall a. a -> Maybe a -> a
fromMaybe Branch m
forall (m :: * -> *). Branch m
empty (Maybe (Branch m) -> Branch m) -> Maybe (Branch m) -> Branch m
forall a b. (a -> b) -> a -> b
$ NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 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_)

setChildBranch :: NameSegment -> Branch m -> Branch0 m -> Branch0 m
setChildBranch :: forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
setChildBranch NameSegment
seg Branch m
b = 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
-> Branch m
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
forall (m :: * -> *).
NameSegment
-> Branch m
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
updateChildren NameSegment
seg Branch m
b)

updateChildren ::
  NameSegment ->
  Branch m ->
  Map NameSegment (Branch m) ->
  Map NameSegment (Branch m)
updateChildren :: forall (m :: * -> *).
NameSegment
-> Branch m
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
updateChildren NameSegment
seg Branch m
updatedChild =
  if Branch m -> Bool
forall (m :: * -> *). Branch m -> Bool
isEmpty Branch m
updatedChild
    then NameSegment
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NameSegment
seg
    else NameSegment
-> Branch m
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NameSegment
seg Branch m
updatedChild

-- Modify the Branch at `path` with `f`, after creating it if necessary.
-- Because it's a `Branch`, it overwrites the history at `path`.
modifyAt ::
  (Applicative m) =>
  Path ->
  (Branch m -> Branch m) ->
  Branch m ->
  Branch m
modifyAt :: forall (m :: * -> *).
Applicative m =>
Path -> (Branch m -> Branch m) -> Branch m -> Branch m
modifyAt Path
path Branch m -> Branch m
f = Identity (Branch m) -> Branch m
forall a. Identity a -> a
runIdentity (Identity (Branch m) -> Branch m)
-> (Branch m -> Identity (Branch m)) -> Branch m -> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path
-> (Branch m -> Identity (Branch m))
-> Branch m
-> Identity (Branch m)
forall (n :: * -> *) (m :: * -> *).
(Functor n, Applicative m) =>
Path -> (Branch m -> n (Branch m)) -> Branch m -> n (Branch m)
modifyAtM Path
path (Branch m -> Identity (Branch m)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch m -> Identity (Branch m))
-> (Branch m -> Branch m) -> Branch m -> Identity (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch m
f)

-- Modify the Branch at `path` with `f`, after creating it if necessary.
-- Because it's a `Branch`, it overwrites the history at `path`.
modifyAtM ::
  forall n m.
  (Functor n, Applicative m) =>
  Path ->
  (Branch m -> n (Branch m)) ->
  Branch m ->
  n (Branch m)
modifyAtM :: forall (n :: * -> *) (m :: * -> *).
(Functor n, Applicative m) =>
Path -> (Branch m -> n (Branch m)) -> Branch m -> n (Branch m)
modifyAtM Path
path Branch m -> n (Branch m)
f = (Algebra (XNor NameSegment) (Branch m -> n (Branch m))
 -> Path -> Branch m -> n (Branch m))
-> Path
-> Algebra (XNor NameSegment) (Branch m -> n (Branch m))
-> Branch m
-> n (Branch m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Algebra (XNor NameSegment) (Branch m -> n (Branch m))
-> Path -> Branch m -> n (Branch m)
forall a. Algebra (XNor NameSegment) a -> Path -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Path
path \case
  XNor NameSegment (Branch m -> n (Branch m))
Neither -> Branch m -> n (Branch m)
f
  Both NameSegment
seg Branch m -> n (Branch m)
fn -> \Branch m
b ->
    -- step the branch by updating its children according to fixup
    ((Branch0 m -> Branch0 m) -> Branch m -> Branch m)
-> Branch m -> (Branch0 m -> Branch0 m) -> Branch m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
step Branch m
b ((Branch0 m -> Branch0 m) -> Branch m)
-> (Branch m -> Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Branch m -> Branch0 m -> Branch0 m
forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
setChildBranch NameSegment
seg (Branch m -> Branch m) -> n (Branch m) -> n (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch m -> n (Branch m)
fn (NameSegment -> Branch0 m -> Branch m
forall (m :: * -> *). NameSegment -> Branch0 m -> Branch m
getChildBranch NameSegment
seg (Branch0 m -> Branch m) -> Branch0 m -> Branch m
forall a b. (a -> b) -> a -> b
$ Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b)

-- | Perform updates over many locations within a branch by batching up operations on
-- sub-branches as much as possible without affecting semantics.
-- This operation does not create any causal conses, the operations are performed directly
-- on the current head of the provided branch and child branches. It's the caller's
-- responsibility to apply updates in history however they choose.
batchUpdates ::
  forall f m.
  (Monad m, Foldable f) =>
  f (Path, Branch0 m -> Branch0 m) ->
  Branch0 m ->
  Branch0 m
batchUpdates :: forall (f :: * -> *) (m :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
batchUpdates f (Path, Branch0 m -> Branch0 m)
actions =
  Identity (Branch0 m) -> Branch0 m
forall a. Identity a -> a
runIdentity (Identity (Branch0 m) -> Branch0 m)
-> (Branch0 m -> Identity (Branch0 m)) -> Branch0 m -> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Path, Branch0 m -> Identity (Branch0 m))]
-> Branch0 m -> Identity (Branch0 m)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch0 m -> n (Branch0 m)
batchUpdatesM [(Path, Branch0 m -> Identity (Branch0 m))]
actionsIdentity
  where
    actionsIdentity :: [(Path, Branch0 m -> Identity (Branch0 m))]
    actionsIdentity :: [(Path, Branch0 m -> Identity (Branch0 m))]
actionsIdentity = [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Identity (Branch0 m))]
forall a b. Coercible a b => a -> b
coerce ([(Path, Branch0 m -> Branch0 m)]
 -> [(Path, Branch0 m -> Identity (Branch0 m))])
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Identity (Branch0 m))]
forall a b. (a -> b) -> a -> b
$ f (Path, Branch0 m -> Branch0 m)
-> [(Path, Branch0 m -> Branch0 m)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Path, Branch0 m -> Branch0 m)
actions

-- | Helper type for grouping up actions according to whether they should be applied at
-- the current branch, or at a child location.
data ActionLocation = HereActions | ChildActions
  deriving (ActionLocation -> ActionLocation -> Bool
(ActionLocation -> ActionLocation -> Bool)
-> (ActionLocation -> ActionLocation -> Bool) -> Eq ActionLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionLocation -> ActionLocation -> Bool
== :: ActionLocation -> ActionLocation -> Bool
$c/= :: ActionLocation -> ActionLocation -> Bool
/= :: ActionLocation -> ActionLocation -> Bool
Eq)

-- | Batch many updates. This allows us to apply the updates while minimizing redundant traversals.
-- Semantics of operations are preserved by ensuring that all updates will always see changes
-- by updates before them in the list.
--
-- This method does not 'step' any branches on its own, all causal changes must be performed in the updates themselves,
-- or this batch update must be provided to 'stepManyAt(M)'.
batchUpdatesM ::
  forall m n f.
  (Monad m, Monad n, Foldable f) =>
  f (Path, Branch0 m -> n (Branch0 m)) ->
  Branch0 m ->
  n (Branch0 m)
batchUpdatesM :: forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch0 m -> n (Branch0 m)
batchUpdatesM (f (Path, Branch0 m -> n (Branch0 m))
-> [(Path, Branch0 m -> n (Branch0 m))]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [(Path, Branch0 m -> n (Branch0 m))]
actions) Branch0 m
curBranch = (Branch0 m
 -> (ActionLocation, [(Path, Branch0 m -> n (Branch0 m))])
 -> n (Branch0 m))
-> Branch0 m
-> [(ActionLocation, [(Path, Branch0 m -> n (Branch0 m))])]
-> n (Branch0 m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Branch0 m
-> (ActionLocation, [(Path, Branch0 m -> n (Branch0 m))])
-> n (Branch0 m)
execActions Branch0 m
curBranch ([(Path, Branch0 m -> n (Branch0 m))]
-> [(ActionLocation, [(Path, Branch0 m -> n (Branch0 m))])]
forall b. [(Path, b)] -> [(ActionLocation, [(Path, b)])]
groupActionsByLocation [(Path, Branch0 m -> n (Branch0 m))]
actions)
  where
    groupActionsByLocation :: [(Path, b)] -> [(ActionLocation, [(Path, b)])]
    groupActionsByLocation :: forall b. [(Path, b)] -> [(ActionLocation, [(Path, b)])]
groupActionsByLocation = ((Path, b) -> (ActionLocation, (Path, b)))
-> [(Path, b)] -> [(ActionLocation, [(Path, b)])]
forall (f :: * -> *) k a b.
(Foldable f, Eq k) =>
(a -> (k, b)) -> f a -> [(k, [b])]
List.groupMap \(Path
p, b
act) -> (Path -> ActionLocation
pathLocation Path
p, (Path
p, b
act))

    execActions ::
      ( Branch0 m ->
        (ActionLocation, [(Path, Branch0 m -> n (Branch0 m))]) ->
        n (Branch0 m)
      )
    execActions :: Branch0 m
-> (ActionLocation, [(Path, Branch0 m -> n (Branch0 m))])
-> n (Branch0 m)
execActions Branch0 m
b = \case
      (ActionLocation
HereActions, [(Path, Branch0 m -> n (Branch0 m))]
acts) -> (Branch0 m -> (Path, Branch0 m -> n (Branch0 m)) -> n (Branch0 m))
-> Branch0 m
-> [(Path, Branch0 m -> n (Branch0 m))]
-> n (Branch0 m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Branch0 m
b (Path
_, Branch0 m -> n (Branch0 m)
act) -> Branch0 m -> n (Branch0 m)
act Branch0 m
b) Branch0 m
b [(Path, Branch0 m -> n (Branch0 m))]
acts
      (ActionLocation
ChildActions, [(Path, Branch0 m -> n (Branch0 m))]
acts) -> Branch0 m
b Branch0 m -> (Branch0 m -> n (Branch0 m)) -> n (Branch0 m)
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
-> Branch0 m -> n (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
 -> Branch0 m -> n (Branch0 m))
-> (Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
-> Branch0 m
-> n (Branch0 m)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
-> Map NameSegment (Branch m) -> n (Map NameSegment (Branch m))
adjustChildren ([(Path, Branch0 m -> n (Branch0 m))]
-> Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
forall x. [(Path, x)] -> Map NameSegment [(Path, x)]
groupByNextSegment [(Path, Branch0 m -> n (Branch0 m))]
acts)

    adjustChildren ::
      Map NameSegment [(Path, Branch0 m -> n (Branch0 m))] ->
      Map NameSegment (Branch m) ->
      n (Map NameSegment (Branch m))
    adjustChildren :: Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
-> Map NameSegment (Branch m) -> n (Map NameSegment (Branch m))
adjustChildren Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
childActions Map NameSegment (Branch m)
children0 =
      (Map NameSegment (Branch m)
 -> (NameSegment, [(Path, Branch0 m -> n (Branch0 m))])
 -> n (Map NameSegment (Branch m)))
-> Map NameSegment (Branch m)
-> [(NameSegment, [(Path, Branch0 m -> n (Branch0 m))])]
-> n (Map NameSegment (Branch m))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map NameSegment (Branch m)
-> (NameSegment, [(Path, Branch0 m -> n (Branch0 m))])
-> n (Map NameSegment (Branch m))
go Map NameSegment (Branch m)
children0 ([(NameSegment, [(Path, Branch0 m -> n (Branch0 m))])]
 -> n (Map NameSegment (Branch m)))
-> [(NameSegment, [(Path, Branch0 m -> n (Branch0 m))])]
-> n (Map NameSegment (Branch m))
forall a b. (a -> b) -> a -> b
$ Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
-> [(NameSegment, [(Path, Branch0 m -> n (Branch0 m))])]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment [(Path, Branch0 m -> n (Branch0 m))]
childActions
      where
        -- Recursively applies the relevant actions to the child branch
        go ::
          ( Map NameSegment (Branch m) ->
            (NameSegment, [(Path, Branch0 m -> n (Branch0 m))]) ->
            n (Map NameSegment (Branch m))
          )
        go :: Map NameSegment (Branch m)
-> (NameSegment, [(Path, Branch0 m -> n (Branch0 m))])
-> n (Map NameSegment (Branch m))
go Map NameSegment (Branch m)
children (NameSegment
seg, [(Path, Branch0 m -> n (Branch0 m))]
acts) = do
          -- 'non empty' creates an empty branch if one is missing,
          -- and similarly deletes a branch if it is empty after modifications.
          -- This is important so that branch actions can create/delete branches.
          Map NameSegment (Branch m)
children Map NameSegment (Branch m)
-> (Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
-> n (Map NameSegment (Branch m))
forall a b. a -> (a -> b) -> b
& Index (Map NameSegment (Branch m))
-> Lens'
     (Map NameSegment (Branch m))
     (Maybe (IxValue (Map NameSegment (Branch m))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NameSegment (Branch m))
NameSegment
seg ((Maybe (Branch m) -> n (Maybe (Branch m)))
 -> Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
-> ((Branch0 m -> n (Branch0 m))
    -> Maybe (Branch m) -> n (Maybe (Branch m)))
-> (Branch0 m -> n (Branch0 m))
-> Map NameSegment (Branch m)
-> n (Map NameSegment (Branch m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Iso' (Maybe (Branch m)) (Branch m)
forall a. Eq a => a -> Iso' (Maybe a) a
non Branch m
forall (m :: * -> *). Branch m
empty ((Branch m -> n (Branch m))
 -> Maybe (Branch m) -> n (Maybe (Branch m)))
-> ((Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m))
-> (Branch0 m -> n (Branch0 m))
-> Maybe (Branch m)
-> n (Maybe (Branch m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m)
head_ ((Branch0 m -> n (Branch0 m))
 -> Map NameSegment (Branch m) -> n (Map NameSegment (Branch m)))
-> (Branch0 m -> n (Branch0 m))
-> Map NameSegment (Branch m)
-> n (Map NameSegment (Branch m))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ [(Path, Branch0 m -> n (Branch0 m))] -> Branch0 m -> n (Branch0 m)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch0 m -> n (Branch0 m)
batchUpdatesM [(Path, Branch0 m -> n (Branch0 m))]
acts
    -- The order of actions across differing keys is irrelevant since those actions can't
    -- affect each other.
    -- The order within a given key is stable.
    groupByNextSegment :: [(Path, x)] -> Map NameSegment [(Path, x)]
    groupByNextSegment :: forall x. [(Path, x)] -> Map NameSegment [(Path, x)]
groupByNextSegment =
      ([(Path, x)] -> [(Path, x)] -> [(Path, x)])
-> [Map NameSegment [(Path, x)]] -> Map NameSegment [(Path, x)]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [(Path, x)] -> [(Path, x)] -> [(Path, x)]
forall a. Semigroup a => a -> a -> a
(<>) ([Map NameSegment [(Path, x)]] -> Map NameSegment [(Path, x)])
-> ([(Path, x)] -> [Map NameSegment [(Path, x)]])
-> [(Path, x)]
-> Map NameSegment [(Path, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path, x) -> Map NameSegment [(Path, x)])
-> [(Path, x)] -> [Map NameSegment [(Path, x)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Path
p, x
action) -> case Path -> XNor NameSegment Path
forall t (f :: * -> *). Recursive t f => t -> f t
project Path
p of
        XNor NameSegment Path
Neither -> [Char] -> Map NameSegment [(Path, x)]
forall a. HasCallStack => [Char] -> a
error [Char]
"groupByNextSegment called on current path, which shouldn't happen."
        Both NameSegment
seg Path
rest -> NameSegment -> [(Path, x)] -> Map NameSegment [(Path, x)]
forall k a. k -> a -> Map k a
Map.singleton NameSegment
seg [(Path
rest, x
action)]
    pathLocation :: Path -> ActionLocation
    pathLocation :: Path -> ActionLocation
pathLocation Path
p = if Path
p Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
forall a. Monoid a => a
mempty then ActionLocation
HereActions else ActionLocation
ChildActions

-- todo: consider inlining these into Actions2
addTermName :: Referent -> NameSegment -> Branch0 m -> Branch0 m
addTermName :: forall (m :: * -> *).
Referent -> NameSegment -> Branch0 m -> Branch0 m
addTermName Referent
r NameSegment
new =
  ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
-> (Star Referent NameSegment -> Star Referent NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_ ((Referent, NameSegment)
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.insertD1 (Referent
r, NameSegment
new))

addTypeName :: TypeReference -> NameSegment -> Branch0 m -> Branch0 m
addTypeName :: forall (m :: * -> *).
TypeReference -> NameSegment -> Branch0 m -> Branch0 m
addTypeName TypeReference
r NameSegment
new =
  ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
-> (Star TypeReference NameSegment
    -> Star TypeReference NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_ ((TypeReference, NameSegment)
-> Star TypeReference NameSegment -> Star TypeReference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.insertD1 (TypeReference
r, NameSegment
new))

deleteTermName :: Referent -> NameSegment -> Branch0 m -> Branch0 m
deleteTermName :: forall (m :: * -> *).
Referent -> NameSegment -> Branch0 m -> Branch0 m
deleteTermName Referent
r NameSegment
n Branch0 m
b
  | (Referent, NameSegment) -> Star Referent NameSegment -> Bool
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Bool
Star2.memberD1 (Referent
r, NameSegment
n) (Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Branch0 m -> Star Referent NameSegment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_ Branch0 m
b) =
      ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
-> (Star Referent NameSegment -> Star Referent NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_ ((Referent, NameSegment)
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deletePrimaryD1 (Referent
r, NameSegment
n)) Branch0 m
b
deleteTermName Referent
_ NameSegment
_ Branch0 m
b = Branch0 m
b

annihilateTermName :: NameSegment -> Branch0 m -> Branch0 m
annihilateTermName :: forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
annihilateTermName = ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
-> (Star Referent NameSegment -> Star Referent NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_ ((Star Referent NameSegment -> Star Referent NameSegment)
 -> Branch0 m -> Branch0 m)
-> (NameSegment
    -> Star Referent NameSegment -> Star Referent NameSegment)
-> NameSegment
-> Branch0 m
-> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
d1 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deleteD1

annihilateTypeName :: NameSegment -> Branch0 m -> Branch0 m
annihilateTypeName :: forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
annihilateTypeName = ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
-> (Star TypeReference NameSegment
    -> Star TypeReference NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_ ((Star TypeReference NameSegment -> Star TypeReference NameSegment)
 -> Branch0 m -> Branch0 m)
-> (NameSegment
    -> Star TypeReference NameSegment
    -> Star TypeReference NameSegment)
-> NameSegment
-> Branch0 m
-> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment
-> Star TypeReference NameSegment -> Star TypeReference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
d1 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deleteD1

deleteTypeName :: TypeReference -> NameSegment -> Branch0 m -> Branch0 m
deleteTypeName :: forall (m :: * -> *).
TypeReference -> NameSegment -> Branch0 m -> Branch0 m
deleteTypeName TypeReference
r NameSegment
n Branch0 m
b
  | (TypeReference, NameSegment)
-> Star TypeReference NameSegment -> Bool
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Bool
Star2.memberD1 (TypeReference
r, NameSegment
n) (Getting
  (Star TypeReference NameSegment)
  (Branch0 m)
  (Star TypeReference NameSegment)
-> Branch0 m -> Star TypeReference NameSegment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Star TypeReference NameSegment)
  (Branch0 m)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_ Branch0 m
b) =
      ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
-> (Star TypeReference NameSegment
    -> Star TypeReference NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TypeReference NameSegment)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_ ((TypeReference, NameSegment)
-> Star TypeReference NameSegment -> Star TypeReference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deletePrimaryD1 (TypeReference
r, NameSegment
n)) Branch0 m
b
deleteTypeName TypeReference
_ NameSegment
_ Branch0 m
b = Branch0 m
b

lca :: (Monad m) => Branch m -> Branch m -> m (Maybe (Branch m))
lca :: forall (m :: * -> *).
Monad m =>
Branch m -> Branch m -> m (Maybe (Branch m))
lca (Branch UnwrappedBranch m
a) (Branch UnwrappedBranch m
b) = (UnwrappedBranch m -> Branch m)
-> Maybe (UnwrappedBranch m) -> Maybe (Branch m)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (Maybe (UnwrappedBranch m) -> Maybe (Branch m))
-> m (Maybe (UnwrappedBranch m)) -> m (Maybe (Branch m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnwrappedBranch m
-> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m))
forall (m :: * -> *) e.
Monad m =>
Causal m e -> Causal m e -> m (Maybe (Causal m e))
Causal.lca UnwrappedBranch m
a UnwrappedBranch m
b

transform :: (Functor m) => (forall a. m a -> n a) -> Branch m -> Branch n
transform :: forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a) -> Branch m -> Branch n
transform forall a. m a -> n a
f Branch m
b = case Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history Branch m
b of
  UnwrappedBranch m
causal -> UnwrappedBranch n -> Branch n
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch n -> Branch n)
-> (Causal m (Branch0 n) -> UnwrappedBranch n)
-> Causal m (Branch0 n)
-> Branch n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> n a) -> Causal m (Branch0 n) -> UnwrappedBranch n
forall (m :: * -> *) (n :: * -> *) e.
Functor m =>
(forall a. m a -> n a) -> Causal m e -> Causal n e
Causal.transform m a -> n a
forall a. m a -> n a
f (Causal m (Branch0 n) -> Branch n)
-> Causal m (Branch0 n) -> Branch n
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> n a) -> UnwrappedBranch m -> Causal m (Branch0 n)
forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a)
-> Causal m (Branch0 m) -> Causal m (Branch0 n)
transformB0s m a -> n a
forall a. m a -> n a
f UnwrappedBranch m
causal
  where
    transformB0s :: (Functor m) => (forall a. m a -> n a) -> Causal m (Branch0 m) -> Causal m (Branch0 n)
    transformB0s :: forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a)
-> Causal m (Branch0 m) -> Causal m (Branch0 n)
transformB0s forall a. m a -> n a
f = (Branch0 m -> Branch0 n)
-> Causal m (Branch0 m) -> Causal m (Branch0 n)
forall (m :: * -> *) e e2.
Functor m =>
(e -> e2) -> Causal m e -> Causal m e2
Causal.unsafeMapHashPreserving ((forall a. m a -> n a) -> Branch0 m -> Branch0 n
forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a) -> Branch0 m -> Branch0 n
transform0 m a -> n a
forall a. m a -> n a
f)

transform0 :: (Functor m) => (forall a. m a -> n a) -> Branch0 m -> Branch0 n
transform0 :: forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a) -> Branch0 m -> Branch0 n
transform0 forall a. m a -> n a
f Branch0 m
b =
  Star Referent NameSegment
-> Star TypeReference NameSegment
-> Map NameSegment (Branch n)
-> Map NameSegment (PatchHash, n Patch)
-> Branch0 n
forall (m :: * -> *).
Star Referent NameSegment
-> Star TypeReference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0 (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
terms_) (Branch0 m
b Branch0 m
-> Getting
     (Star TypeReference NameSegment)
     (Branch0 m)
     (Star TypeReference NameSegment)
-> Star TypeReference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star TypeReference NameSegment)
  (Branch0 m)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types_) Map NameSegment (Branch n)
newChildren Map NameSegment (PatchHash, n Patch)
newEdits
  where
    newChildren :: Map NameSegment (Branch n)
newChildren = (forall a. m a -> n a) -> Branch m -> Branch n
forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a) -> Branch m -> Branch n
transform m a -> n a
forall a. m a -> n a
f (Branch m -> Branch n)
-> Map NameSegment (Branch m) -> Map NameSegment (Branch n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 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_)
    newEdits :: Map NameSegment (PatchHash, n Patch)
newEdits = (m Patch -> n Patch)
-> (PatchHash, m Patch) -> (PatchHash, n Patch)
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 m Patch -> n Patch
forall a. m a -> n a
f ((PatchHash, m Patch) -> (PatchHash, n Patch))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, n Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
edits_)

-- | Traverse the head branch of all direct children.
-- The index of the traversal is the name of that child branch according to the parent.
children0 :: IndexedTraversal' NameSegment (Branch0 m) (Branch0 m)
children0 :: forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Indexable NameSegment p, Applicative f) =>
p (Branch0 m) (f (Branch0 m)) -> Branch0 m -> f (Branch0 m)
children0 = (Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
 -> Branch0 m -> f (Branch0 m))
-> (p (Branch0 m) (f (Branch0 m))
    -> Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> p (Branch0 m) (f (Branch0 m))
-> Branch0 m
-> f (Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.> Indexed NameSegment (Branch m) (f (Branch m))
-> Map NameSegment (Branch m) -> f (Map NameSegment (Branch m))
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
IndexedTraversal
  NameSegment
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
  (Branch m)
  (Branch m)
itraversed (Indexed NameSegment (Branch m) (f (Branch m))
 -> Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> ((Branch0 m -> f (Branch0 m)) -> Branch m -> f (Branch m))
-> p (Branch0 m) (f (Branch0 m))
-> Map NameSegment (Branch m)
-> f (Map NameSegment (Branch m))
forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. ((UnwrappedBranch m -> f (UnwrappedBranch m))
-> Branch m -> f (Branch m)
forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UnwrappedBranch m) (f (UnwrappedBranch m))
-> p (Branch m) (f (Branch m))
history_ ((UnwrappedBranch m -> f (UnwrappedBranch m))
 -> Branch m -> f (Branch m))
-> ((Branch0 m -> f (Branch0 m))
    -> UnwrappedBranch m -> f (UnwrappedBranch m))
-> (Branch0 m -> f (Branch0 m))
-> Branch m
-> f (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 m -> f (Branch0 m))
-> UnwrappedBranch m -> f (UnwrappedBranch m)
forall e (m :: * -> *).
ContentAddressable e =>
Lens' (Causal m e) e
Lens' (UnwrappedBranch m) (Branch0 m)
Causal.head_)

-- | @head `consBranchSnapshot` base@ Cons's the current state of @head@ onto @base@ as-is.
-- Consider whether you really want this behaviour or the behaviour of 'Causal.squashMerge'
-- That is, it does not perform any common ancestor detection, or change reconciliation, it
-- sets the current state of the base branch to the new state as a new causal step (or returns
-- the existing base if there are no)
consBranchSnapshot ::
  forall m.
  (Monad m) =>
  Branch m ->
  Branch m ->
  Branch m
-- If the target branch is empty we just replace it.
consBranchSnapshot :: forall (m :: * -> *). Monad m => Branch m -> Branch m -> Branch m
consBranchSnapshot Branch m
headBranch Branch m
Empty = Branch m -> Branch m
forall {m :: * -> *}. Applicative m => Branch m -> Branch m
discardHistory Branch m
headBranch
consBranchSnapshot Branch m
headBranch Branch m
baseBranch =
  if Branch m
baseBranch Branch m -> Branch m -> Bool
forall a. Eq a => a -> a -> Bool
== Branch m
headBranch
    then Branch m
baseBranch
    else
      UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch m -> Branch m) -> UnwrappedBranch m -> Branch m
forall a b. (a -> b) -> a -> b
$
        Branch0 m -> UnwrappedBranch m -> UnwrappedBranch m
forall (m :: * -> *) e.
(Applicative m, Eq e, ContentAddressable e) =>
e -> Causal m e -> Causal m e
Causal.consDistinct
          (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
headBranch Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch m)
 -> Identity (Map NameSegment (Branch m)))
-> Branch0 m -> Identity (Branch0 m)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children_ ((Map NameSegment (Branch m)
  -> Identity (Map NameSegment (Branch m)))
 -> Branch0 m -> Identity (Branch0 m))
-> Map NameSegment (Branch m) -> Branch0 m -> Branch0 m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map NameSegment (Branch m)
combinedChildren)
          (Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history Branch m
baseBranch)
  where
    combineChildren :: These (Branch m) (Branch m) -> Maybe (Branch m)
    combineChildren :: These (Branch m) (Branch m) -> Maybe (Branch m)
combineChildren = \case
      -- If we have a matching child in both base and head, squash the child head onto the
      -- child base recursively.
      (These Branch m
base Branch m
head) -> Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just (Branch m
head Branch m -> Branch m -> Branch m
forall (m :: * -> *). Monad m => Branch m -> Branch m -> Branch m
`consBranchSnapshot` Branch m
base)
      -- This child has been deleted, let it be
      (This Branch m
_) -> Maybe (Branch m)
forall a. Maybe a
Nothing
      -- This child didn't exist in the base, we add any changes as a single commit
      (That Branch m
head) -> Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just (Branch m -> Branch m
forall {m :: * -> *}. Applicative m => Branch m -> Branch m
discardHistory Branch m
head)
    combinedChildren :: Map NameSegment (Branch m)
    combinedChildren :: Map NameSegment (Branch m)
combinedChildren =
      (These (Branch m) (Branch m) -> Maybe (Branch m))
-> Map NameSegment (These (Branch m) (Branch m))
-> Map NameSegment (Branch m)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe These (Branch m) (Branch m) -> Maybe (Branch m)
combineChildren (Map NameSegment (These (Branch m) (Branch m))
 -> Map NameSegment (Branch m))
-> Map NameSegment (These (Branch m) (Branch m))
-> Map NameSegment (Branch m)
forall a b. (a -> b) -> a -> b
$
        Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
-> Map NameSegment (These (Branch m) (Branch m))
forall a b.
Map NameSegment a
-> Map NameSegment b -> Map NameSegment (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Align.align
          (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
baseBranch Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 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_)
          (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
headBranch Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 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_)