{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

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

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

    -- * properties
    history,
    head,
    head_,
    headHash,
    children,
    nonEmptyChildren,
    deepEdits',
    toList0,
    namespaceStats,

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

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

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

    -- * Branch terms/types/edits

    -- ** Term/type/edits lenses
    terms,
    types,
    edits,

    -- ** Term/type queries
    deepTerms,
    deepTypes,
    deepDefns,
    deepEdits,
    deepPaths,
    deepReferents,
    deepTermReferences,
    deepTermReferenceIds,
    deepTypeReferences,
    deepTypeReferenceIds,
    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, PatchHash (..))
import Unison.Codebase.Branch.Raw (Raw)
import Unison.Codebase.Branch.Type
  ( Branch (..),
    Branch0,
    NamespaceHash,
    Star,
    UnwrappedBranch,
    branch0,
    children,
    deepDefns,
    deepEdits,
    deepPaths,
    deepTerms,
    deepTypes,
    edits,
    head,
    headHash,
    history,
    isEmpty0,
    nonEmptyChildren,
    terms,
    types,
  )
import Unison.Codebase.Causal (Causal)
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Patch (Patch)
import Unison.Codebase.Patch qualified as Patch
import Unison.Codebase.Path (Path (..))
import Unison.Codebase.Path qualified as Path
import Unison.Hashing.V2 qualified as Hashing (ContentAddressable (contentHash))
import Unison.Hashing.V2.Convert qualified as H
import Unison.Name (Name)
import Unison.Name qualified as 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.List qualified as List
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 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

-- | 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 :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
children ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
-> ((Map NameSegment (Branch m)
     -> Identity (Map NameSegment (Branch m)))
    -> Map NameSegment (Branch m)
    -> Identity (Map NameSegment (Branch m)))
-> ASetter
     (Branch0 m)
     (Branch0 m)
     (Map NameSegment (Branch m))
     (Map NameSegment (Branch 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 -> Identity (Branch m))
 -> Map NameSegment (Branch m)
 -> Identity (Map NameSegment (Branch m)))
-> ((Map NameSegment (Branch m)
     -> Identity (Map NameSegment (Branch m)))
    -> Branch m -> Identity (Branch m))
-> (Map NameSegment (Branch m)
    -> Identity (Map NameSegment (Branch m)))
-> Map NameSegment (Branch m)
-> Identity (Map NameSegment (Branch m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> ASetter
     (Branch0 m)
     (Branch0 m)
     (Map NameSegment (Branch m))
     (Map NameSegment (Branch m))
-> (Map NameSegment (Branch m)
    -> Identity (Map NameSegment (Branch m)))
-> Branch m
-> Identity (Branch m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
dep)

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

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 TermReference
deepTermReferences =
  (Referent -> Maybe TermReference)
-> Set Referent -> Set TermReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TermReference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Set Referent -> Set TermReference)
-> (Branch0 m -> Set Referent) -> Branch0 m -> Set TermReference
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 TermReference
deepTypeReferences = Relation TermReference Name -> Set TermReference
forall a b. Relation a b -> Set a
R.dom (Relation TermReference Name -> Set TermReference)
-> (Branch0 m -> Relation TermReference Name)
-> Branch0 m
-> Set TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Relation TermReference Name
forall (m :: * -> *). Branch0 m -> Relation TermReference Name
deepTypes

deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId
deepTypeReferenceIds :: forall (m :: * -> *). Branch0 m -> Set TermReferenceId
deepTypeReferenceIds =
  (TermReference -> Maybe TermReferenceId)
-> Set TermReference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TermReference -> Maybe TermReferenceId
Reference.toId (Set TermReference -> Set TermReferenceId)
-> (Branch0 m -> Set TermReference)
-> Branch0 m
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Set TermReference
forall (m :: * -> *). Branch0 m -> Set TermReference
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 TermReference Name -> Int
forall a b. Relation a b -> Int
Relation.size (Relation TermReference Name -> Int)
-> Relation TermReference Name -> Int
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Relation TermReference Name
forall (m :: * -> *). Branch0 m -> Relation TermReference Name
deepTypes Branch0 m
b,
      $sel:numContainedPatches:NamespaceStats :: Int
numContainedPatches = Map Name PatchHash -> Int
forall k a. Map k a -> Int
Map.size (Map Name PatchHash -> Int) -> Map Name PatchHash -> Int
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Map Name PatchHash
forall (m :: * -> *). Branch0 m -> Map Name PatchHash
deepEdits Branch0 m
b
    }

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

-- | a version of `deepEdits` that returns the `m Patch` as well.
deepEdits' :: Branch0 m -> Map Name (PatchHash, m Patch)
deepEdits' :: forall (m :: * -> *). Branch0 m -> Map Name (PatchHash, m Patch)
deepEdits' = (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
forall (m :: * -> *).
(Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
go Name -> Name
forall a. a -> a
id
  where
    -- can change this to an actual prefix once Name is a [NameSegment]
    go :: (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
    go :: forall (m :: * -> *).
(Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
go Name -> Name
addPrefix Branch0 m
b0 =
      (NameSegment -> Name)
-> Map NameSegment (PatchHash, m Patch)
-> Map Name (PatchHash, m Patch)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Name -> Name
addPrefix (Name -> Name) -> (NameSegment -> Name) -> NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Name
Name.fromSegment) (Branch0 m
b0 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)
        Map Name (PatchHash, m Patch)
-> Map Name (PatchHash, m Patch) -> Map Name (PatchHash, m Patch)
forall a. Semigroup a => a -> a -> a
<> ((NameSegment, Branch m) -> Map Name (PatchHash, m Patch))
-> [(NameSegment, Branch m)] -> Map Name (PatchHash, m Patch)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
forall (m :: * -> *).
(NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
f (Map NameSegment (Branch m) -> [(NameSegment, Branch m)]
forall k a. Map k a -> [(k, a)]
Map.toList (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))
      where
        f :: (NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
        f :: forall (m :: * -> *).
(NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
f (NameSegment
c, Branch m
b) = (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
forall (m :: * -> *).
(Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
go (Name -> Name
addPrefix (Name -> Name) -> (Name -> Name) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => NameSegment -> Name -> Name
NameSegment -> Name -> Name
Name.cons NameSegment
c) (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b)

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

-- | what does this do? —AI
toList0 :: Branch0 m -> [(Path, Branch0 m)]
toList0 :: forall (m :: * -> *). Branch0 m -> [(Path, Branch0 m)]
toList0 = Path -> Branch0 m -> [(Path, Branch0 m)]
forall {m :: * -> *}. Path -> Branch0 m -> [(Path, Branch0 m)]
go Path
Path.empty
  where
    go :: Path -> Branch0 m -> [(Path, Branch0 m)]
go Path
p Branch0 m
b =
      (Path
p, Branch0 m
b)
        (Path, Branch0 m) -> [(Path, Branch0 m)] -> [(Path, Branch0 m)]
forall a. a -> [a] -> [a]
: ( Map NameSegment (Branch m) -> [(NameSegment, Branch m)]
forall k a. Map k a -> [(k, a)]
Map.toList (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)
              [(NameSegment, Branch m)]
-> ((NameSegment, Branch m) -> [(Path, Branch0 m)])
-> [(Path, Branch0 m)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \(NameSegment
seg, Branch m
cb) ->
                      Path -> Branch0 m -> [(Path, Branch0 m)]
go (Path -> NameSegment -> Path
Path.snoc Path
p NameSegment
seg) (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
cb)
                  )
          )

-- 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 Path
path Branch m
root = case Path -> Maybe (NameSegment, Path)
Path.uncons Path
path of
  Maybe (NameSegment, Path)
Nothing -> 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
  Just (NameSegment
seg, Path
path) -> case NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
root 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) of
    Just Branch m
b -> Path -> Branch m -> Maybe (Branch m)
forall (m :: * -> *). Path -> Branch m -> Maybe (Branch m)
getAt Path
path Branch m
b
    Maybe (Branch m)
Nothing -> Maybe (Branch m)
forall a. Maybe a
Nothing

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 Path
p Branch0 m
b = case Path -> Maybe (NameSegment, Path)
Path.uncons Path
p of
  Maybe (NameSegment, Path)
Nothing -> Branch0 m
b
  Just (NameSegment
seg, Path
path) -> case 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) of
    Just Branch m
c -> Path -> Branch0 m -> Branch0 m
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
getAt0 Path
path (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
c)
    Maybe (Branch m)
Nothing -> Branch0 m
forall (m :: * -> *). Branch0 m
empty0

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

getPatch :: (Applicative m) => NameSegment -> Branch0 m -> m Patch
getPatch :: forall (m :: * -> *).
Applicative m =>
NameSegment -> Branch0 m -> m Patch
getPatch NameSegment
seg Branch0 m
b = case NameSegment
-> Map NameSegment (PatchHash, m Patch)
-> Maybe (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (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) of
  Maybe (PatchHash, m Patch)
Nothing -> Patch -> m Patch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Patch
Patch.empty
  Just (PatchHash
_, m Patch
p) -> m Patch
p

getMaybePatch :: (Applicative m) => NameSegment -> Branch0 m -> m (Maybe Patch)
getMaybePatch :: forall (m :: * -> *).
Applicative m =>
NameSegment -> Branch0 m -> m (Maybe Patch)
getMaybePatch NameSegment
seg Branch0 m
b = case NameSegment
-> Map NameSegment (PatchHash, m Patch)
-> Maybe (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (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) of
  Maybe (PatchHash, m Patch)
Nothing -> Maybe Patch -> m (Maybe Patch)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Patch
forall a. Maybe a
Nothing
  Just (PatchHash
_, m Patch
p) -> Patch -> Maybe Patch
forall a. a -> Maybe a
Just (Patch -> Maybe Patch) -> m Patch -> m (Maybe Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Patch
p

modifyPatches ::
  (Monad m) => NameSegment -> (Patch -> Patch) -> Branch0 m -> m (Branch0 m)
modifyPatches :: forall (m :: * -> *).
Monad m =>
NameSegment -> (Patch -> Patch) -> Branch0 m -> m (Branch0 m)
modifyPatches NameSegment
seg Patch -> Patch
f = LensLike
  (WrappedMonad m)
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
  (Map NameSegment (PatchHash, m Patch))
-> (Map NameSegment (PatchHash, m Patch)
    -> m (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m
-> m (Branch0 m)
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike
  (WrappedMonad m)
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
  (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 Map NameSegment (PatchHash, m Patch)
-> m (Map NameSegment (PatchHash, m Patch))
update
  where
    update :: Map NameSegment (PatchHash, m Patch)
-> m (Map NameSegment (PatchHash, m Patch))
update Map NameSegment (PatchHash, m Patch)
m = do
      Patch
p' <- case NameSegment
-> Map NameSegment (PatchHash, m Patch)
-> Maybe (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg Map NameSegment (PatchHash, m Patch)
m of
        Maybe (PatchHash, m Patch)
Nothing -> Patch -> m Patch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Patch -> m Patch) -> Patch -> m Patch
forall a b. (a -> b) -> a -> b
$ Patch -> Patch
f Patch
Patch.empty
        Just (PatchHash
_, m Patch
p) -> Patch -> Patch
f (Patch -> Patch) -> m Patch -> m Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Patch
p
      let h :: Hash
h = Patch -> Hash
H.hashPatch Patch
p'
      Map NameSegment (PatchHash, m Patch)
-> m (Map NameSegment (PatchHash, m Patch))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NameSegment (PatchHash, m Patch)
 -> m (Map NameSegment (PatchHash, m Patch)))
-> Map NameSegment (PatchHash, m Patch)
-> m (Map NameSegment (PatchHash, m Patch))
forall a b. (a -> b) -> a -> b
$ NameSegment
-> (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NameSegment
seg (Hash -> PatchHash
PatchHash Hash
h, Patch -> m Patch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Patch
p') Map NameSegment (PatchHash, m Patch)
m

replacePatch :: (Applicative m) => NameSegment -> Patch -> Branch0 m -> Branch0 m
replacePatch :: forall (m :: * -> *).
Applicative m =>
NameSegment -> Patch -> Branch0 m -> Branch0 m
replacePatch NameSegment
n Patch
p = ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
  (Map NameSegment (PatchHash, m Patch))
-> (Map NameSegment (PatchHash, m Patch)
    -> Map NameSegment (PatchHash, m Patch))
-> 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 (PatchHash, m Patch))
  (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 (NameSegment
-> (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NameSegment
n (Hash -> PatchHash
PatchHash (Patch -> Hash
H.hashPatch Patch
p), Patch -> m Patch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Patch
p))

deletePatch :: NameSegment -> Branch0 m -> Branch0 m
deletePatch :: forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
deletePatch NameSegment
n = ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
  (Map NameSegment (PatchHash, m Patch))
-> (Map NameSegment (PatchHash, m Patch)
    -> Map NameSegment (PatchHash, m Patch))
-> 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 (PatchHash, m Patch))
  (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 (NameSegment
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NameSegment
n)

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 Branch m
b = case Path -> Maybe (NameSegment, Path)
Path.uncons Path
path of
  Maybe (NameSegment, Path)
Nothing -> Branch m -> n (Branch m)
f Branch m
b
  Just (NameSegment
seg, Path
path) ->
    let child :: Branch m
child = NameSegment -> Branch0 m -> Branch m
forall (m :: * -> *). NameSegment -> Branch0 m -> Branch m
getChildBranch NameSegment
seg (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
b)
     in -- step the branch by updating its children according to fixup
        (\Branch m
child' -> (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
step (NameSegment -> Branch m -> Branch0 m -> Branch0 m
forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
setChildBranch NameSegment
seg Branch m
child') Branch m
b) (Branch m -> Branch m) -> n (Branch m) -> n (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> (Branch m -> n (Branch m)) -> Branch m -> n (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 -> n (Branch m)
f Branch m
child

-- | 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 \case
        (NameSegment
seg :< Path
rest, x
action) -> NameSegment -> [(Path, x)] -> Map NameSegment [(Path, x)]
forall k a. k -> a -> Map k a
Map.singleton NameSegment
seg [(Path
rest, x
action)]
        (Path, x)
_ -> [Char] -> Map NameSegment [(Path, x)]
forall a. HasCallStack => [Char] -> a
error [Char]
"groupByNextSegment called on current path, which shouldn't happen."
    pathLocation :: Path -> ActionLocation
    pathLocation :: Path -> ActionLocation
pathLocation (Path Seq NameSegment
Empty) = ActionLocation
HereActions
    pathLocation Path
_ = 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 :: * -> *).
TermReference -> NameSegment -> Branch0 m -> Branch0 m
addTypeName TermReference
r NameSegment
new =
  ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TermReference NameSegment)
  (Star TermReference NameSegment)
-> (Star TermReference NameSegment
    -> Star TermReference 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 TermReference NameSegment)
  (Star TermReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TermReference NameSegment
 -> f (Star TermReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types ((TermReference, NameSegment)
-> Star TermReference NameSegment -> Star TermReference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.insertD1 (TermReference
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 TermReference NameSegment)
  (Star TermReference NameSegment)
-> (Star TermReference NameSegment
    -> Star TermReference 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 TermReference NameSegment)
  (Star TermReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TermReference NameSegment
 -> f (Star TermReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types ((Star TermReference NameSegment -> Star TermReference NameSegment)
 -> Branch0 m -> Branch0 m)
-> (NameSegment
    -> Star TermReference NameSegment
    -> Star TermReference NameSegment)
-> NameSegment
-> Branch0 m
-> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment
-> Star TermReference NameSegment -> Star TermReference 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 :: * -> *).
TermReference -> NameSegment -> Branch0 m -> Branch0 m
deleteTypeName TermReference
r NameSegment
n Branch0 m
b
  | (TermReference, NameSegment)
-> Star TermReference NameSegment -> Bool
forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Bool
Star2.memberD1 (TermReference
r, NameSegment
n) (Getting
  (Star TermReference NameSegment)
  (Branch0 m)
  (Star TermReference NameSegment)
-> Branch0 m -> Star TermReference NameSegment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Star TermReference NameSegment)
  (Branch0 m)
  (Star TermReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TermReference NameSegment
 -> f (Star TermReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types Branch0 m
b) =
      ASetter
  (Branch0 m)
  (Branch0 m)
  (Star TermReference NameSegment)
  (Star TermReference NameSegment)
-> (Star TermReference NameSegment
    -> Star TermReference 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 TermReference NameSegment)
  (Star TermReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TermReference NameSegment
 -> f (Star TermReference NameSegment))
-> Branch0 m -> f (Branch0 m)
types ((TermReference, NameSegment)
-> Star TermReference NameSegment -> Star TermReference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deletePrimaryD1 (TermReference
r, NameSegment
n)) Branch0 m
b
deleteTypeName TermReference
_ 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 TermReference NameSegment
-> Map NameSegment (Branch n)
-> Map NameSegment (PatchHash, n Patch)
-> Branch0 n
forall (m :: * -> *).
Star Referent NameSegment
-> Star TermReference 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 TermReference NameSegment)
     (Branch0 m)
     (Star TermReference NameSegment)
-> Star TermReference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star TermReference NameSegment)
  (Branch0 m)
  (Star TermReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TermReference NameSegment
 -> f (Star TermReference 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)