module Unison.Codebase.Branch.Merge
  ( MergeMode (..),
    merge'',
  )
where

import Data.Map qualified as Map
import Data.Map.Merge.Lazy qualified as Map
import Unison.Codebase.Branch
  ( Branch (..),
    Branch0,
    branch0,
    cons,
    discardHistory0,
    empty0,
    head,
    isEmpty,
    isEmpty0,
  )
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.BranchDiff (BranchDiff (BranchDiff))
import Unison.Codebase.Branch.BranchDiff qualified as BDiff
import Unison.Codebase.Causal qualified as Causal
import Unison.Prelude hiding (empty)
import Unison.Util.Map (unionWithM)
import Unison.Util.Star2 qualified as Star2
import Prelude hiding (head, read, subtract)

data MergeMode = RegularMerge | SquashMerge deriving (MergeMode -> MergeMode -> Bool
(MergeMode -> MergeMode -> Bool)
-> (MergeMode -> MergeMode -> Bool) -> Eq MergeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MergeMode -> MergeMode -> Bool
== :: MergeMode -> MergeMode -> Bool
$c/= :: MergeMode -> MergeMode -> Bool
/= :: MergeMode -> MergeMode -> Bool
Eq, Eq MergeMode
Eq MergeMode =>
(MergeMode -> MergeMode -> Ordering)
-> (MergeMode -> MergeMode -> Bool)
-> (MergeMode -> MergeMode -> Bool)
-> (MergeMode -> MergeMode -> Bool)
-> (MergeMode -> MergeMode -> Bool)
-> (MergeMode -> MergeMode -> MergeMode)
-> (MergeMode -> MergeMode -> MergeMode)
-> Ord MergeMode
MergeMode -> MergeMode -> Bool
MergeMode -> MergeMode -> Ordering
MergeMode -> MergeMode -> MergeMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MergeMode -> MergeMode -> Ordering
compare :: MergeMode -> MergeMode -> Ordering
$c< :: MergeMode -> MergeMode -> Bool
< :: MergeMode -> MergeMode -> Bool
$c<= :: MergeMode -> MergeMode -> Bool
<= :: MergeMode -> MergeMode -> Bool
$c> :: MergeMode -> MergeMode -> Bool
> :: MergeMode -> MergeMode -> Bool
$c>= :: MergeMode -> MergeMode -> Bool
>= :: MergeMode -> MergeMode -> Bool
$cmax :: MergeMode -> MergeMode -> MergeMode
max :: MergeMode -> MergeMode -> MergeMode
$cmin :: MergeMode -> MergeMode -> MergeMode
min :: MergeMode -> MergeMode -> MergeMode
Ord, Int -> MergeMode -> ShowS
[MergeMode] -> ShowS
MergeMode -> String
(Int -> MergeMode -> ShowS)
-> (MergeMode -> String)
-> ([MergeMode] -> ShowS)
-> Show MergeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MergeMode -> ShowS
showsPrec :: Int -> MergeMode -> ShowS
$cshow :: MergeMode -> String
show :: MergeMode -> String
$cshowList :: [MergeMode] -> ShowS
showList :: [MergeMode] -> ShowS
Show)

merge'' ::
  forall m.
  (Monad m) =>
  (Branch m -> Branch m -> m (Maybe (Branch m))) -> -- lca calculator
  MergeMode ->
  Branch m ->
  Branch m ->
  m (Branch m)
merge'' :: forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
_ MergeMode
_ Branch m
b1 Branch m
b2 | Branch m -> Bool
forall (m :: * -> *). Branch m -> Bool
isEmpty Branch m
b1 = Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
b2
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
_ MergeMode
mode Branch m
b1 Branch m
b2 | Branch m -> Bool
forall (m :: * -> *). Branch m -> Bool
isEmpty Branch m
b2 = case MergeMode
mode of
  MergeMode
RegularMerge -> Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
b1
  MergeMode
SquashMerge -> Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch m -> m (Branch m)) -> Branch m -> m (Branch m)
forall a b. (a -> b) -> a -> b
$ Branch0 m -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
cons (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
b1)) Branch m
b2
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode (Branch UnwrappedBranch m
x) (Branch UnwrappedBranch m
y) =
  UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch m -> Branch m)
-> m (UnwrappedBranch m) -> m (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case MergeMode
mode of
    MergeMode
RegularMerge -> (UnwrappedBranch m
 -> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m)))
-> (Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m))
-> UnwrappedBranch m
-> UnwrappedBranch m
-> m (UnwrappedBranch m)
forall (m :: * -> *) e.
(Monad m, ContentAddressable e) =>
(Causal m e -> Causal m e -> m (Maybe (Causal m e)))
-> (Maybe e -> e -> e -> m e)
-> Causal m e
-> Causal m e
-> m (Causal m e)
Causal.threeWayMerge' UnwrappedBranch m
-> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m))
lca' Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m)
combine UnwrappedBranch m
x UnwrappedBranch m
y
    MergeMode
SquashMerge -> (UnwrappedBranch m
 -> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m)))
-> (Branch0 m -> m (Branch0 m))
-> (Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m))
-> UnwrappedBranch m
-> UnwrappedBranch m
-> m (UnwrappedBranch m)
forall (m :: * -> *) e.
(Monad m, ContentAddressable e, Eq e) =>
(Causal m e -> Causal m e -> m (Maybe (Causal m e)))
-> (e -> m e)
-> (Maybe e -> e -> e -> m e)
-> Causal m e
-> Causal m e
-> m (Causal m e)
Causal.squashMerge' UnwrappedBranch m
-> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m))
lca' (Branch0 m -> m (Branch0 m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 m -> m (Branch0 m))
-> (Branch0 m -> Branch0 m) -> Branch0 m -> m (Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Branch0 m
forall (m :: * -> *). Applicative m => Branch0 m -> Branch0 m
discardHistory0) Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m)
combine UnwrappedBranch m
x UnwrappedBranch m
y
  where
    lca' :: UnwrappedBranch m
-> UnwrappedBranch m -> m (Maybe (UnwrappedBranch m))
lca' UnwrappedBranch m
c1 UnwrappedBranch m
c2 = (Branch m -> UnwrappedBranch m)
-> Maybe (Branch m) -> Maybe (UnwrappedBranch m)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
_history (Maybe (Branch m) -> Maybe (UnwrappedBranch m))
-> m (Maybe (Branch m)) -> m (Maybe (UnwrappedBranch m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch m -> Branch m -> m (Maybe (Branch m))
lca (UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch UnwrappedBranch m
c1) (UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch UnwrappedBranch m
c2)
    combine :: Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m)
    combine :: Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m)
combine Maybe (Branch0 m)
Nothing Branch0 m
l Branch0 m
r = (Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch0 m -> Branch0 m -> m (Branch0 m)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch0 m -> Branch0 m -> m (Branch0 m)
merge0 Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode Branch0 m
l Branch0 m
r
    combine (Just Branch0 m
ca) Branch0 m
l Branch0 m
r = do
      let dl :: BranchDiff
dl = Branch0 m -> Branch0 m -> BranchDiff
forall (m :: * -> *). Branch0 m -> Branch0 m -> BranchDiff
BDiff.diff0 Branch0 m
ca Branch0 m
l
      let dr :: BranchDiff
dr = Branch0 m -> Branch0 m -> BranchDiff
forall (m :: * -> *). Branch0 m -> Branch0 m -> BranchDiff
BDiff.diff0 Branch0 m
ca Branch0 m
r
      let head0 :: Branch0 m
head0 = Branch0 m -> BranchDiff -> Branch0 m
apply Branch0 m
ca (BranchDiff
dl BranchDiff -> BranchDiff -> BranchDiff
forall a. Semigroup a => a -> a -> a
<> BranchDiff
dr)
      Map NameSegment (Branch m)
children <-
        WhenMissing m NameSegment (Branch m) (Branch m)
-> WhenMissing m NameSegment (Branch m) (Branch m)
-> WhenMatched m NameSegment (Branch m) (Branch m) (Branch m)
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
-> m (Map NameSegment (Branch m))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
          ((NameSegment -> Branch m -> m (Maybe (Branch m)))
-> WhenMissing m NameSegment (Branch m) (Branch m)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
Map.traverseMaybeMissing ((NameSegment -> Branch m -> m (Maybe (Branch m)))
 -> WhenMissing m NameSegment (Branch m) (Branch m))
-> (NameSegment -> Branch m -> m (Maybe (Branch m)))
-> WhenMissing m NameSegment (Branch m) (Branch m)
forall a b. (a -> b) -> a -> b
$ Branch0 m -> NameSegment -> Branch m -> m (Maybe (Branch m))
combineMissing Branch0 m
ca)
          ((NameSegment -> Branch m -> m (Maybe (Branch m)))
-> WhenMissing m NameSegment (Branch m) (Branch m)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
Map.traverseMaybeMissing ((NameSegment -> Branch m -> m (Maybe (Branch m)))
 -> WhenMissing m NameSegment (Branch m) (Branch m))
-> (NameSegment -> Branch m -> m (Maybe (Branch m)))
-> WhenMissing m NameSegment (Branch m) (Branch m)
forall a b. (a -> b) -> a -> b
$ Branch0 m -> NameSegment -> Branch m -> m (Maybe (Branch m))
combineMissing Branch0 m
ca)
          ((NameSegment -> Branch m -> Branch m -> m (Branch m))
-> WhenMatched m NameSegment (Branch m) (Branch m) (Branch m)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
Map.zipWithAMatched ((NameSegment -> Branch m -> Branch m -> m (Branch m))
 -> WhenMatched m NameSegment (Branch m) (Branch m) (Branch m))
-> (NameSegment -> Branch m -> Branch m -> m (Branch m))
-> WhenMatched m NameSegment (Branch m) (Branch m) (Branch m)
forall a b. (a -> b) -> a -> b
$ (Branch m -> Branch m -> m (Branch m))
-> NameSegment -> Branch m -> Branch m -> m (Branch m)
forall a b. a -> b -> a
const ((Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode))
          (Branch0 m
l 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)
Branch.children_)
          (Branch0 m
r 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)
Branch.children_)
      pure $ Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0 (Branch0 m
head0 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)
Branch.terms_) (Branch0 m
head0 Branch0 m
-> Getting
     (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
-> Star Value NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Value NameSegment -> f (Star Value NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types_) Map NameSegment (Branch m)
children (Branch0 m
head0 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)
Branch.edits_)

    combineMissing :: Branch0 m -> NameSegment -> Branch m -> m (Maybe (Branch m))
combineMissing Branch0 m
ca NameSegment
k Branch m
cur =
      case NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
k (Branch0 m
ca 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)
Branch.children_) of
        Maybe (Branch m)
Nothing -> Maybe (Branch m) -> m (Maybe (Branch m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Branch m) -> m (Maybe (Branch m)))
-> Maybe (Branch m) -> m (Maybe (Branch m))
forall a b. (a -> b) -> a -> b
$ Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just Branch m
cur
        Just Branch m
old -> do
          Branch m
nw <- (Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode (Branch0 m -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
cons Branch0 m
forall (m :: * -> *). Branch0 m
empty0 Branch m
old) Branch m
cur
          if Branch0 m -> Bool
forall (m :: * -> *). Branch0 m -> Bool
isEmpty0 (Branch0 m -> Bool) -> Branch0 m -> Bool
forall a b. (a -> b) -> a -> b
$ Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
head Branch m
nw
            then Maybe (Branch m) -> m (Maybe (Branch m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Branch m)
forall a. Maybe a
Nothing
            else Maybe (Branch m) -> m (Maybe (Branch m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Branch m) -> m (Maybe (Branch m)))
-> Maybe (Branch m) -> m (Maybe (Branch m))
forall a b. (a -> b) -> a -> b
$ Branch m -> Maybe (Branch m)
forall a. a -> Maybe a
Just Branch m
nw

    apply :: Branch0 m -> BranchDiff -> Branch0 m
    apply :: Branch0 m -> BranchDiff -> Branch0 m
apply Branch0 m
b0 (BranchDiff Star Referent NameSegment
addedTerms Star Referent NameSegment
removedTerms Star Value NameSegment
addedTypes Star Value NameSegment
removedTypes) = do
      Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0
        (Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
b0 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)
Branch.terms_) Star Referent NameSegment
removedTerms Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall a. Semigroup a => a -> a -> a
<> Star Referent NameSegment
addedTerms)
        (Star Value NameSegment
-> Star Value NameSegment -> Star Value NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
b0 Branch0 m
-> Getting
     (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
-> Star Value NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Value NameSegment -> f (Star Value NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types_) Star Value NameSegment
removedTypes Star Value NameSegment
-> Star Value NameSegment -> Star Value NameSegment
forall a. Semigroup a => a -> a -> a
<> Star Value NameSegment
addedTypes)
        (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)
Branch.children_)
        Map NameSegment (PatchHash, m Patch)
forall k a. Map k a
Map.empty

merge0 ::
  forall m.
  (Monad m) =>
  (Branch m -> Branch m -> m (Maybe (Branch m))) ->
  MergeMode ->
  Branch0 m ->
  Branch0 m ->
  m (Branch0 m)
merge0 :: forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch0 m -> Branch0 m -> m (Branch0 m)
merge0 Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode Branch0 m
b1 Branch0 m
b2 = do
  Map NameSegment (Branch m)
c3 <- (Branch m -> Branch m -> m (Branch m))
-> Map NameSegment (Branch m)
-> Map NameSegment (Branch m)
-> m (Map NameSegment (Branch m))
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
(a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
unionWithM ((Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
merge'' Branch m -> Branch m -> m (Maybe (Branch m))
lca MergeMode
mode) (Branch0 m
b1 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)
Branch.children_) (Branch0 m
b2 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)
Branch.children_)
  pure $
    Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Value NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
branch0
      (Branch0 m
b1 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)
Branch.terms_ Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall a. Semigroup a => a -> a -> a
<> Branch0 m
b2 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)
Branch.terms_)
      (Branch0 m
b1 Branch0 m
-> Getting
     (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
-> Star Value NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Value NameSegment -> f (Star Value NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types_ Star Value NameSegment
-> Star Value NameSegment -> Star Value NameSegment
forall a. Semigroup a => a -> a -> a
<> Branch0 m
b2 Branch0 m
-> Getting
     (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
-> Star Value NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Value NameSegment) (Branch0 m) (Star Value NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Value NameSegment -> f (Star Value NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types_)
      Map NameSegment (Branch m)
c3
      Map NameSegment (PatchHash, m Patch)
forall k a. Map k a
Map.empty