-- | @merge@ input handler.
module Unison.Codebase.Editor.HandleInput.Merge2
  ( handleMerge,

    -- * API exported for @pull@
    MergeInfo (..),
    AliceMergeInfo (..),
    BobMergeInfo (..),
    LcaMergeInfo (..),
    doMerge,
    doMergeLocalBranch,

    -- * API exported for @todo@
    hasDefnsInLib,
  )
where

import Control.Monad.Reader (ask)
import Data.Map.Strict qualified as Map
import Data.Semialign (zipWith)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.These (These (..))
import Text.ANSI qualified as Text
import Text.Builder qualified
import Text.Builder qualified as Text (Builder)
import U.Codebase.Branch qualified as V2 (Branch (..), CausalBranch)
import U.Codebase.Branch qualified as V2.Branch
import U.Codebase.Causal qualified as V2.Causal
import U.Codebase.HashTags (CausalHash, unCausalHash)
import U.Codebase.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId)
import U.Codebase.Sqlite.DbId (ProjectId)
import U.Codebase.Sqlite.Operations qualified as Operations
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..))
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Cli.UpdateUtils
  ( getNamespaceDependentsOf3,
    hydrateDefns,
    loadNamespaceDefinitions,
  )
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode (..))
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache)
import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
import Unison.Codebase.SqliteCodebase.Operations qualified as Operations
import Unison.ConstructorType (ConstructorType)
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.Debug qualified as Debug
import Unison.Hash qualified as Hash
import Unison.Merge qualified as Merge
import Unison.Merge.EitherWayI qualified as EitherWayI
import Unison.Merge.Synhashed qualified as Synhashed
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Name (Name)
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Project
  ( ProjectAndBranch (..),
    ProjectBranchName,
    ProjectBranchNameKind (..),
    ProjectName,
    Semver (..),
    classifyProjectBranchName,
  )
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.ReferentPrime qualified as Referent'
import Unison.Sqlite (Transaction)
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UnisonFile
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Conflicted (Conflicted)
import Unison.Util.Defn (Defn)
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Nametree (Nametree (..), unflattenNametree)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation
import Unison.Util.Star2 (Star2)
import Unison.Util.Star2 qualified as Star2
import Unison.WatchKind qualified as WatchKind
import Witch (unsafeFrom)
import Prelude hiding (unzip, zip, zipWith)

handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleMerge (ProjectAndBranch Maybe ProjectName
maybeBobProjectName ProjectBranchName
bobBranchName) = do
  -- Assert that Alice (us) is on a project branch, and grab the causal hash.
  ProjectPath Project
aliceProject ProjectBranch
aliceProjectBranch Absolute
_path <- Cli (ProjectPathG Project ProjectBranch)
Cli.getCurrentProjectPath
  let aliceProjectAndBranch :: ProjectAndBranch Project ProjectBranch
aliceProjectAndBranch = Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
aliceProject ProjectBranch
aliceProjectBranch

  -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch
  -- name, and causal hash.
  Project
bobProject <-
    case Maybe ProjectName
maybeBobProjectName of
      Maybe ProjectName
Nothing -> Project -> Cli Project
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch Project ProjectBranch
aliceProjectAndBranch.project
      Just ProjectName
bobProjectName
        | ProjectName
bobProjectName ProjectName -> ProjectName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectAndBranch Project ProjectBranch
aliceProjectAndBranch.project.name -> Project -> Cli Project
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch Project ProjectBranch
aliceProjectAndBranch.project
        | Bool
otherwise -> do
            Transaction (Maybe Project) -> Cli (Maybe Project)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
bobProjectName)
              Cli (Maybe Project)
-> (Cli (Maybe Project) -> Cli Project) -> Cli Project
forall a b. a -> (a -> b) -> b
& Cli Project -> Cli (Maybe Project) -> Cli Project
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM (Output -> Cli Project
forall a. Output -> Cli a
Cli.returnEarly (ProjectName -> Output
Output.LocalProjectDoesntExist ProjectName
bobProjectName))
  ProjectBranch
bobProjectBranch <- Project -> ProjectBranchName -> Cli ProjectBranch
ProjectUtils.expectProjectBranchByName Project
bobProject ProjectBranchName
bobBranchName
  let bobProjectAndBranch :: ProjectAndBranch Project ProjectBranch
bobProjectAndBranch = Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
bobProject ProjectBranch
bobProjectBranch

  TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli ()
doMergeLocalBranch
    Merge.TwoWay
      { $sel:alice:TwoWay :: ProjectAndBranch Project ProjectBranch
alice = ProjectAndBranch Project ProjectBranch
aliceProjectAndBranch,
        $sel:bob:TwoWay :: ProjectAndBranch Project ProjectBranch
bob = ProjectAndBranch Project ProjectBranch
bobProjectAndBranch
      }

data MergeInfo = MergeInfo
  { MergeInfo -> AliceMergeInfo
alice :: !AliceMergeInfo,
    MergeInfo -> BobMergeInfo
bob :: !BobMergeInfo,
    MergeInfo -> LcaMergeInfo
lca :: !LcaMergeInfo,
    -- | How should we describe this merge in the reflog?
    MergeInfo -> Text
description :: !Text
  }

data AliceMergeInfo = AliceMergeInfo
  { AliceMergeInfo -> CausalHash
causalHash :: !CausalHash,
    AliceMergeInfo -> ProjectAndBranch Project ProjectBranch
projectAndBranch :: !(ProjectAndBranch Project ProjectBranch)
  }

data BobMergeInfo = BobMergeInfo
  { BobMergeInfo -> CausalHash
causalHash :: !CausalHash,
    BobMergeInfo -> MergeSource
source :: !MergeSource
  }

newtype LcaMergeInfo = LcaMergeInfo
  { LcaMergeInfo -> Maybe CausalHash
causalHash :: Maybe CausalHash
  }

doMerge :: MergeInfo -> Cli ()
doMerge :: MergeInfo -> Cli ()
doMerge MergeInfo
info = do
  let debugFunctions :: DebugFunctions
debugFunctions =
        if DebugFlag -> Bool
Debug.shouldDebug DebugFlag
Debug.Merge
          then DebugFunctions
realDebugFunctions
          else DebugFunctions
fakeDebugFunctions

  let aliceBranchNames :: MergeTarget
aliceBranchNames = ProjectAndBranch Project ProjectBranch -> MergeTarget
ProjectUtils.justTheNames MergeInfo
info.alice.projectAndBranch
  let mergeSource :: MergeSourceOrTarget
mergeSource = MergeSource -> MergeSourceOrTarget
MergeSourceOrTarget'Source MergeInfo
info.bob.source
  let mergeTarget :: MergeSourceOrTarget
mergeTarget = MergeTarget -> MergeSourceOrTarget
MergeSourceOrTarget'Target MergeTarget
aliceBranchNames
  let mergeSourceAndTarget :: MergeSourceAndTarget
mergeSourceAndTarget = MergeSourceAndTarget {$sel:alice:MergeSourceAndTarget :: MergeTarget
alice = MergeTarget
aliceBranchNames, $sel:bob:MergeSourceAndTarget :: MergeSource
bob = MergeInfo
info.bob.source}

  Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  Output
finalOutput <-
    ((forall a. Output -> Cli a) -> Cli Output) -> Cli Output
forall a. ((forall void. a -> Cli void) -> Cli a) -> Cli a
Cli.label \forall a. Output -> Cli a
done -> do
      -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done.
      Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MergeInfo
info.alice.causalHash CausalHash -> CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== MergeInfo
info.bob.causalHash Bool -> Bool -> Bool
|| MergeInfo
info.lca.causalHash Maybe CausalHash -> Maybe CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just MergeInfo
info.bob.causalHash) do
        Output -> Cli ()
forall a. Output -> Cli a
done (MergeSourceAndTarget -> Output
Output.MergeAlreadyUpToDate2 MergeSourceAndTarget
mergeSourceAndTarget)

      -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done.
      Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MergeInfo
info.lca.causalHash Maybe CausalHash -> Maybe CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just MergeInfo
info.alice.causalHash) do
        Branch IO
bobBranch <- IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> CausalHash -> IO (Branch IO)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
Codebase.expectBranchForHash Env
env.codebase MergeInfo
info.bob.causalHash)
        Bool
_ <- Text
-> ProjectPathG Project ProjectBranch
-> (Branch IO -> Branch IO)
-> Cli Bool
Cli.updateAt MergeInfo
info.description (ProjectAndBranch Project ProjectBranch
-> ProjectPathG Project ProjectBranch
PP.projectBranchRoot MergeInfo
info.alice.projectAndBranch) (\Branch IO
_aliceBranch -> Branch IO
bobBranch)
        Output -> Cli ()
forall a. Output -> Cli a
done (MergeSourceAndTarget -> Output
Output.MergeSuccessFastForward MergeSourceAndTarget
mergeSourceAndTarget)

      -- Load Alice/Bob/LCA causals
      TwoOrThreeWay (CausalBranch Transaction)
causals <-
        Transaction (TwoOrThreeWay (CausalBranch Transaction))
-> Cli (TwoOrThreeWay (CausalBranch Transaction))
forall a. Transaction a -> Cli a
Cli.runTransaction do
          (CausalHash -> Transaction (CausalBranch Transaction))
-> TwoOrThreeWay CausalHash
-> Transaction (TwoOrThreeWay (CausalBranch Transaction))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TwoOrThreeWay a -> f (TwoOrThreeWay b)
traverse
            CausalHash -> Transaction (CausalBranch Transaction)
Operations.expectCausalBranchByCausalHash
            Merge.TwoOrThreeWay
              { $sel:alice:TwoOrThreeWay :: CausalHash
alice = MergeInfo
info.alice.causalHash,
                $sel:bob:TwoOrThreeWay :: CausalHash
bob = MergeInfo
info.bob.causalHash,
                $sel:lca:TwoOrThreeWay :: Maybe CausalHash
lca = MergeInfo
info.lca.causalHash
              }

      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DebugFunctions
debugFunctions.debugCausals TwoOrThreeWay (CausalBranch Transaction)
causals)

      -- Load Alice/Bob/LCA branches
      TwoOrThreeWay (Branch Transaction)
branches <-
        Transaction (TwoOrThreeWay (Branch Transaction))
-> Cli (TwoOrThreeWay (Branch Transaction))
forall a. Transaction a -> Cli a
Cli.runTransaction do
          Branch Transaction
alice <- TwoOrThreeWay (CausalBranch Transaction)
causals.alice.value
          Branch Transaction
bob <- TwoOrThreeWay (CausalBranch Transaction)
causals.bob.value
          Maybe (Branch Transaction)
lca <- Maybe (CausalBranch Transaction)
-> (CausalBranch Transaction -> Transaction (Branch Transaction))
-> Transaction (Maybe (Branch Transaction))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for TwoOrThreeWay (CausalBranch Transaction)
causals.lca \CausalBranch Transaction
causal -> CausalBranch Transaction
causal.value
          pure Merge.TwoOrThreeWay {Maybe (Branch Transaction)
$sel:lca:TwoOrThreeWay :: Maybe (Branch Transaction)
lca :: Maybe (Branch Transaction)
lca, Branch Transaction
$sel:alice:TwoOrThreeWay :: Branch Transaction
alice :: Branch Transaction
alice, Branch Transaction
$sel:bob:TwoOrThreeWay :: Branch Transaction
bob :: Branch Transaction
bob}

      -- Assert that neither Alice nor Bob have defns in lib
      [(MergeSourceOrTarget, Branch Transaction)]
-> ((MergeSourceOrTarget, Branch Transaction) -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(MergeSourceOrTarget
mergeTarget, TwoOrThreeWay (Branch Transaction)
branches.alice), (MergeSourceOrTarget
mergeSource, TwoOrThreeWay (Branch Transaction)
branches.bob)] \(MergeSourceOrTarget
who, Branch Transaction
branch) -> do
        Cli Bool -> Cli () -> Cli ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Transaction Bool -> Cli Bool
forall a. Transaction a -> Cli a
Cli.runTransaction (Branch Transaction -> Transaction Bool
forall (m :: * -> *). Applicative m => Branch m -> m Bool
hasDefnsInLib Branch Transaction
branch)) do
          Output -> Cli ()
forall a. Output -> Cli a
done (MergeSourceOrTarget -> Output
Output.MergeDefnsInLib MergeSourceOrTarget
who)

      -- Load Alice/Bob/LCA definitions
      --
      -- FIXME: Oops, if this fails due to a conflicted name, we don't actually say where the conflicted name came from.
      -- We should have a better error message (even though you can't do anything about conflicted names in the LCA).
      ThreeWay
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
nametrees3 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) <- do
        let referent2to1 :: Referent -> Transaction Referent
referent2to1 = (TypeReference -> Transaction ConstructorType)
-> Referent -> Transaction Referent
forall (m :: * -> *).
Applicative m =>
(TypeReference -> m ConstructorType) -> Referent -> m Referent
Conversions.referent2to1 (Codebase IO Symbol Ann
-> TypeReference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
Codebase.getDeclType Env
env.codebase)
        let action ::
              (forall a. Defn (Conflicted Name Referent) (Conflicted Name TypeReference) -> Transaction a) ->
              Transaction (Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
            action :: (forall a.
 Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction a)
-> Transaction
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
action forall a.
Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction a
rollback = do
              Nametree (DefnsF (Map NameSegment) Referent TypeReference)
alice <- (Referent -> Transaction Referent)
-> Branch Transaction
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall (m :: * -> *).
Monad m =>
(Referent -> m Referent)
-> Branch m
-> m (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
loadNamespaceDefinitions Referent -> Transaction Referent
referent2to1 TwoOrThreeWay (Branch Transaction)
branches.alice Transaction
  (Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> (Transaction
      (Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
    -> Transaction
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a.
Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction a
rollback
              Nametree (DefnsF (Map NameSegment) Referent TypeReference)
bob <- (Referent -> Transaction Referent)
-> Branch Transaction
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall (m :: * -> *).
Monad m =>
(Referent -> m Referent)
-> Branch m
-> m (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
loadNamespaceDefinitions Referent -> Transaction Referent
referent2to1 TwoOrThreeWay (Branch Transaction)
branches.bob Transaction
  (Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> (Transaction
      (Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
    -> Transaction
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a.
Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction a
rollback
              Nametree (DefnsF (Map NameSegment) Referent TypeReference)
lca <-
                case TwoOrThreeWay (Branch Transaction)
branches.lca of
                  Maybe (Branch Transaction)
Nothing -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nametree {$sel:value:Nametree :: DefnsF (Map NameSegment) Referent TypeReference
value = Map NameSegment Referent
-> Map NameSegment TypeReference
-> DefnsF (Map NameSegment) Referent TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map NameSegment Referent
forall k a. Map k a
Map.empty Map NameSegment TypeReference
forall k a. Map k a
Map.empty, $sel:children:Nametree :: Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children = Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall k a. Map k a
Map.empty}
                  Just Branch Transaction
lca -> (Referent -> Transaction Referent)
-> Branch Transaction
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall (m :: * -> *).
Monad m =>
(Referent -> m Referent)
-> Branch m
-> m (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
loadNamespaceDefinitions Referent -> Transaction Referent
referent2to1 Branch Transaction
lca Transaction
  (Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> (Transaction
      (Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
    -> Transaction
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a.
Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction a
rollback
              pure Merge.ThreeWay {Nametree (DefnsF (Map NameSegment) Referent TypeReference)
alice :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
$sel:alice:ThreeWay :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
alice, Nametree (DefnsF (Map NameSegment) Referent TypeReference)
bob :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
$sel:bob:ThreeWay :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
bob, Nametree (DefnsF (Map NameSegment) Referent TypeReference)
lca :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
$sel:lca:ThreeWay :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
lca}
        ((forall void.
  Either
    (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
    (ThreeWay
       (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
  -> Transaction void)
 -> Transaction
      (Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (ThreeWay
            (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))))
-> Cli
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (ThreeWay
           (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
forall a.
((forall void. a -> Transaction void) -> Transaction a) -> Cli a
Cli.runTransactionWithRollback2 (\forall void.
Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  (ThreeWay
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction void
rollback -> ThreeWay
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall a b. b -> Either a b
Right (ThreeWay
   (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
 -> Either
      (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
      (ThreeWay
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> Transaction
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (ThreeWay
           (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a.
 Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction a)
-> Transaction
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
action (Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  (ThreeWay
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction a
forall void.
Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  (ThreeWay
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Transaction void
rollback (Either
   (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
   (ThreeWay
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
 -> Transaction a)
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (ThreeWay
            (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall a b. a -> Either a b
Left))
          Cli
  (Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> (Cli
      (Either
         (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
         (ThreeWay
            (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
    -> Cli
         (ThreeWay
            (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> Cli
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Cli
      (ThreeWay
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> Cli
     (Either
        (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
        (ThreeWay
           (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> Cli
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM (Output
-> Cli
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall a. Output -> Cli a
done (Output
 -> Cli
      (ThreeWay
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference))))
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Output)
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Cli
     (ThreeWay
        (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Output
Output.ConflictedDefn Text
"merge")

      ThreeWay (Map NameSegment (CausalBranch Transaction))
libdeps3 <- Transaction (ThreeWay (Map NameSegment (CausalBranch Transaction)))
-> Cli (ThreeWay (Map NameSegment (CausalBranch Transaction)))
forall a. Transaction a -> Cli a
Cli.runTransaction (TwoOrThreeWay (Branch Transaction)
-> Transaction
     (ThreeWay (Map NameSegment (CausalBranch Transaction)))
loadLibdeps TwoOrThreeWay (Branch Transaction)
branches)

      let blob0 :: Mergeblob0 (CausalBranch Transaction)
blob0 = ThreeWay
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> ThreeWay (Map NameSegment (CausalBranch Transaction))
-> Mergeblob0 (CausalBranch Transaction)
forall libdep.
ThreeWay
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> ThreeWay (Map NameSegment libdep) -> Mergeblob0 libdep
Merge.makeMergeblob0 ThreeWay
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
nametrees3 ThreeWay (Map NameSegment (CausalBranch Transaction))
libdeps3

      -- Hydrate
      ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns ::
        Merge.ThreeWay
          ( DefnsF
              (Map Name)
              (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
              (TypeReferenceId, Decl Symbol Ann)
          ) <-
        Transaction
  (ThreeWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann)))
-> Cli
     (ThreeWay
        (DefnsF
           (Map Name)
           (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
           (TermReferenceId, Decl Symbol Ann)))
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction
   (ThreeWay
      (DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann)))
 -> Cli
      (ThreeWay
         (DefnsF
            (Map Name)
            (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
            (TermReferenceId, Decl Symbol Ann))))
-> Transaction
     (ThreeWay
        (DefnsF
           (Map Name)
           (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
           (TermReferenceId, Decl Symbol Ann)))
-> Cli
     (ThreeWay
        (DefnsF
           (Map Name)
           (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
           (TermReferenceId, Decl Symbol Ann)))
forall a b. (a -> b) -> a -> b
$
          (DefnsF (Map Name) TermReferenceId TermReferenceId
 -> Transaction
      (DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann)))
-> ThreeWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> Transaction
     (ThreeWay
        (DefnsF
           (Map Name)
           (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
           (TermReferenceId, Decl Symbol Ann)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ThreeWay a -> f (ThreeWay b)
traverse
            ( (Hash -> Transaction [(Term Symbol Ann, Type Symbol Ann)])
-> (Hash -> Transaction [Decl Symbol Ann])
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> Transaction
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall (m :: * -> *) name term typ.
(Monad m, Ord name) =>
(Hash -> m [term])
-> (Hash -> m [typ])
-> DefnsF (Map name) TermReferenceId TermReferenceId
-> m (DefnsF
        (Map name) (TermReferenceId, term) (TermReferenceId, typ))
hydrateDefns
                (Codebase IO Symbol Ann
-> Hash -> Transaction [(Term Symbol Ann, Type Symbol Ann)]
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Hash -> Transaction [(Term v a, Type v a)]
Codebase.unsafeGetTermComponent Env
env.codebase)
                HasCallStack => Hash -> Transaction [Decl Symbol Ann]
Hash -> Transaction [Decl Symbol Ann]
Operations.expectDeclComponent
            )
            ( let f :: BiMultimap Referent k -> Map k TermReferenceId
f = (Referent -> Maybe TermReferenceId)
-> Map k Referent -> Map k TermReferenceId
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Referent -> Maybe TermReferenceId
Referent.toTermReferenceId (Map k Referent -> Map k TermReferenceId)
-> (BiMultimap Referent k -> Map k Referent)
-> BiMultimap Referent k
-> Map k TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap Referent k -> Map k Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range
                  g :: BiMultimap TypeReference k -> Map k TermReferenceId
g = (TypeReference -> Maybe TermReferenceId)
-> Map k TypeReference -> Map k TermReferenceId
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe TypeReference -> Maybe TermReferenceId
Reference.toId (Map k TypeReference -> Map k TermReferenceId)
-> (BiMultimap TypeReference k -> Map k TypeReference)
-> BiMultimap TypeReference k
-> Map k TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap TypeReference k -> Map k TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range
               in (BiMultimap Referent Name -> Map Name TermReferenceId)
-> (BiMultimap TypeReference Name -> Map Name TermReferenceId)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BiMultimap Referent Name -> Map Name TermReferenceId
forall {k}. BiMultimap Referent k -> Map k TermReferenceId
f BiMultimap TypeReference Name -> Map Name TermReferenceId
forall {k}. BiMultimap TypeReference k -> Map k TermReferenceId
g (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF (Map Name) TermReferenceId TermReferenceId)
-> ThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> ThreeWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mergeblob0 (CausalBranch Transaction)
blob0.defns
            )

      Mergeblob1 (CausalBranch Transaction)
blob1 <-
        Mergeblob0 (CausalBranch Transaction)
-> ThreeWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> Either
     (EitherWay IncoherentDeclReason)
     (Mergeblob1 (CausalBranch Transaction))
forall libdep.
Eq libdep =>
Mergeblob0 libdep
-> ThreeWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> Either (EitherWay IncoherentDeclReason) (Mergeblob1 libdep)
Merge.makeMergeblob1 Mergeblob0 (CausalBranch Transaction)
blob0 ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns Either
  (EitherWay IncoherentDeclReason)
  (Mergeblob1 (CausalBranch Transaction))
-> (Either
      (EitherWay IncoherentDeclReason)
      (Mergeblob1 (CausalBranch Transaction))
    -> Cli (Mergeblob1 (CausalBranch Transaction)))
-> Cli (Mergeblob1 (CausalBranch Transaction))
forall a b. a -> (a -> b) -> b
& (EitherWay IncoherentDeclReason
 -> Cli (Mergeblob1 (CausalBranch Transaction)))
-> Either
     (EitherWay IncoherentDeclReason)
     (Mergeblob1 (CausalBranch Transaction))
-> Cli (Mergeblob1 (CausalBranch Transaction))
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \case
          Merge.Alice IncoherentDeclReason
reason -> Output -> Cli (Mergeblob1 (CausalBranch Transaction))
forall a. Output -> Cli a
done (MergeSourceOrTarget -> IncoherentDeclReason -> Output
Output.IncoherentDeclDuringMerge MergeSourceOrTarget
mergeTarget IncoherentDeclReason
reason)
          Merge.Bob IncoherentDeclReason
reason -> Output -> Cli (Mergeblob1 (CausalBranch Transaction))
forall a. Output -> Cli a
done (MergeSourceOrTarget -> IncoherentDeclReason -> Output
Output.IncoherentDeclDuringMerge MergeSourceOrTarget
mergeSource IncoherentDeclReason
reason)

      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DebugFunctions
debugFunctions.debugDiffs Mergeblob1 (CausalBranch Transaction)
blob1.diffs)

      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DebugFunctions
debugFunctions.debugCombinedDiff Mergeblob1 (CausalBranch Transaction)
blob1.diff)

      Mergeblob2 (CausalBranch Transaction)
blob2 <-
        Mergeblob1 (CausalBranch Transaction)
-> Either Mergeblob2Error (Mergeblob2 (CausalBranch Transaction))
forall libdep.
Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep)
Merge.makeMergeblob2 Mergeblob1 (CausalBranch Transaction)
blob1 Either Mergeblob2Error (Mergeblob2 (CausalBranch Transaction))
-> (Either Mergeblob2Error (Mergeblob2 (CausalBranch Transaction))
    -> Cli (Mergeblob2 (CausalBranch Transaction)))
-> Cli (Mergeblob2 (CausalBranch Transaction))
forall a b. a -> (a -> b) -> b
& (Mergeblob2Error -> Cli (Mergeblob2 (CausalBranch Transaction)))
-> Either Mergeblob2Error (Mergeblob2 (CausalBranch Transaction))
-> Cli (Mergeblob2 (CausalBranch Transaction))
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \Mergeblob2Error
err ->
          Output -> Cli (Mergeblob2 (CausalBranch Transaction))
forall a. Output -> Cli a
done case Mergeblob2Error
err of
            Merge.Mergeblob2Error'ConflictedAlias EitherWay (Defn (Name, Name) (Name, Name))
defn0 ->
              case EitherWay (Defn (Name, Name) (Name, Name))
defn0 of
                Merge.Alice Defn (Name, Name) (Name, Name)
defn -> MergeSourceOrTarget -> Defn (Name, Name) (Name, Name) -> Output
Output.MergeConflictedAliases MergeSourceOrTarget
mergeTarget Defn (Name, Name) (Name, Name)
defn
                Merge.Bob Defn (Name, Name) (Name, Name)
defn -> MergeSourceOrTarget -> Defn (Name, Name) (Name, Name) -> Output
Output.MergeConflictedAliases MergeSourceOrTarget
mergeSource Defn (Name, Name) (Name, Name)
defn
            Merge.Mergeblob2Error'ConflictedBuiltin Defn Name Name
defn -> Defn Name Name -> Output
Output.MergeConflictInvolvingBuiltin Defn Name Name
defn

      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DebugFunctions
debugFunctions.debugPartitionedDiff Mergeblob2 (CausalBranch Transaction)
blob2.conflicts Mergeblob2 (CausalBranch Transaction)
blob2.unconflicts)

      TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependents0 <-
        Transaction (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
-> Cli (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
 -> Cli (TwoWay (DefnsF Set TermReferenceId TermReferenceId)))
-> Transaction
     (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
-> Cli (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
forall a b. (a -> b) -> a -> b
$
          TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name),
   DefnsF Set TypeReference TypeReference)
-> ((Defns
       (BiMultimap Referent Name) (BiMultimap TypeReference Name),
     DefnsF Set TypeReference TypeReference)
    -> Transaction (DefnsF Set TermReferenceId TermReferenceId))
-> Transaction
     (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ((,) (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF Set TypeReference TypeReference
 -> (Defns
       (BiMultimap Referent Name) (BiMultimap TypeReference Name),
     DefnsF Set TypeReference TypeReference))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (DefnsF Set TypeReference TypeReference
      -> (Defns
            (BiMultimap Referent Name) (BiMultimap TypeReference Name),
          DefnsF Set TypeReference TypeReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Mergeblob2 (CausalBranch Transaction)
blob2.defns TwoWay
  (DefnsF Set TypeReference TypeReference
   -> (Defns
         (BiMultimap Referent Name) (BiMultimap TypeReference Name),
       DefnsF Set TypeReference TypeReference))
-> TwoWay (DefnsF Set TypeReference TypeReference)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name),
      DefnsF Set TypeReference TypeReference)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mergeblob2 (CausalBranch Transaction)
blob2.coreDependencies) \(Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns, DefnsF Set TypeReference TypeReference
deps) ->
            Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF Set TypeReference TypeReference
-> Transaction (DefnsF Set TermReferenceId TermReferenceId)
getNamespaceDependentsOf3 Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns DefnsF Set TypeReference TypeReference
deps

      -- Load and merge Alice's and Bob's libdeps
      Branch0 Transaction
mergedLibdeps <-
        Transaction (Branch0 Transaction) -> Cli (Branch0 Transaction)
forall a. Transaction a -> Cli a
Cli.runTransaction ((TypeReference -> Transaction ConstructorType)
-> Map NameSegment (CausalBranch Transaction)
-> Transaction (Branch0 Transaction)
libdepsToBranch0 (Codebase IO Symbol Ann
-> TypeReference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
Codebase.getDeclType Env
env.codebase) Mergeblob2 (CausalBranch Transaction)
blob2.libdeps)

      let hasConflicts :: Bool
hasConflicts =
            Mergeblob2 (CausalBranch Transaction)
blob2.hasConflicts

      let blob3 :: Mergeblob3
blob3 =
            Mergeblob2 (CausalBranch Transaction)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> TwoWay Text
-> Mergeblob3
forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> TwoWay Text
-> Mergeblob3
Merge.makeMergeblob3
              Mergeblob2 (CausalBranch Transaction)
blob2
              TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependents0
              (Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 Transaction
mergedLibdeps)
              Merge.TwoWay
                { $sel:alice:TwoWay :: Text
alice = forall target source. From source target => source -> target
into @Text MergeTarget
aliceBranchNames,
                  $sel:bob:TwoWay :: Text
bob =
                    case MergeInfo
info.bob.source of
                      MergeSource'LocalProjectBranch MergeTarget
bobBranchNames -> forall target source. From source target => source -> target
into @Text MergeTarget
bobBranchNames
                      MergeSource'RemoteProjectBranch MergeTarget
bobBranchNames
                        | MergeTarget
aliceBranchNames MergeTarget -> MergeTarget -> Bool
forall a. Eq a => a -> a -> Bool
== MergeTarget
bobBranchNames -> Text
"remote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text MergeTarget
bobBranchNames
                        | Bool
otherwise -> forall target source. From source target => source -> target
into @Text MergeTarget
bobBranchNames
                      MergeSource'RemoteLooseCode ReadShareLooseCode
info ->
                        case Path -> Maybe Name
Path.toName ReadShareLooseCode
info.path of
                          Maybe Name
Nothing -> Text
"<root>"
                          Just Name
name -> Name -> Text
Name.toText Name
name
                }

      Maybe Mergeblob5
maybeBlob5 <-
        if Bool
hasConflicts
          then Maybe Mergeblob5 -> Cli (Maybe Mergeblob5)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Mergeblob5
forall a. Maybe a
Nothing
          else case Mergeblob3 -> Either (Err Symbol) Mergeblob4
Merge.makeMergeblob4 Mergeblob3
blob3 of
            Left Err Symbol
_parseErr -> Maybe Mergeblob5 -> Cli (Maybe Mergeblob5)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Mergeblob5
forall a. Maybe a
Nothing
            Right Mergeblob4
blob4 -> do
              TypeLookup Symbol Ann
typeLookup <- Transaction (TypeLookup Symbol Ann) -> Cli (TypeLookup Symbol Ann)
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> DefnsF Set TypeReference TypeReference
-> Transaction (TypeLookup Symbol Ann)
Codebase.typeLookupForDependencies Env
env.codebase Mergeblob4
blob4.dependencies)
              pure case Mergeblob4
-> TypeLookup Symbol Ann
-> Either (Seq (Note Symbol Ann)) Mergeblob5
Merge.makeMergeblob5 Mergeblob4
blob4 TypeLookup Symbol Ann
typeLookup of
                Left Seq (Note Symbol Ann)
_typecheckErr -> Maybe Mergeblob5
forall a. Maybe a
Nothing
                Right Mergeblob5
blob5 -> Mergeblob5 -> Maybe Mergeblob5
forall a. a -> Maybe a
Just Mergeblob5
blob5

      let parents :: TwoOrThreeWay (CausalHash, IO (Branch IO))
parents =
            TwoOrThreeWay (CausalBranch Transaction)
causals TwoOrThreeWay (CausalBranch Transaction)
-> (CausalBranch Transaction -> (CausalHash, IO (Branch IO)))
-> TwoOrThreeWay (CausalHash, IO (Branch IO))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \CausalBranch Transaction
causal -> (CausalBranch Transaction
causal.causalHash, Codebase IO Symbol Ann -> CausalHash -> IO (Branch IO)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
Codebase.expectBranchForHash Env
env.codebase CausalBranch Transaction
causal.causalHash)

      Mergeblob5
blob5 <-
        Maybe Mergeblob5
maybeBlob5 Maybe Mergeblob5
-> (Maybe Mergeblob5 -> Cli Mergeblob5) -> Cli Mergeblob5
forall a b. a -> (a -> b) -> b
& Cli Mergeblob5 -> Maybe Mergeblob5 -> Cli Mergeblob5
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
          Cli.Env {Text -> Text -> IO ()
writeSource :: Text -> Text -> IO ()
$sel:writeSource:Env :: Env -> Text -> Text -> IO ()
writeSource} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
          (ProjectBranchId
_temporaryBranchId, ProjectBranchName
temporaryBranchName) <-
            Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli (ProjectBranchId, ProjectBranchName)
HandleInput.Branch.createBranch
              MergeInfo
info.description
              ( ProjectBranch -> Branch IO -> CreateFrom
HandleInput.Branch.CreateFrom'NamespaceWithParent
                  MergeInfo
info.alice.projectAndBranch.branch
                  ( Branch0 IO
-> (CausalHash, IO (Branch IO))
-> (CausalHash, IO (Branch IO))
-> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m
-> (CausalHash, m (Branch m))
-> (CausalHash, m (Branch m))
-> Branch m
Branch.mergeNode
                      (Codebase IO Symbol Ann
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 Transaction
-> Branch0 IO
forall v a.
Codebase IO v a
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 Transaction
-> Branch0 IO
defnsAndLibdepsToBranch0 Env
env.codebase Mergeblob3
blob3.stageTwo Branch0 Transaction
mergedLibdeps)
                      TwoOrThreeWay (CausalHash, IO (Branch IO))
parents.alice
                      TwoOrThreeWay (CausalHash, IO (Branch IO))
parents.bob
                  )
              )
              MergeInfo
info.alice.projectAndBranch.project
              (ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName
findTemporaryBranchName MergeInfo
info.alice.projectAndBranch.project.projectId MergeSourceAndTarget
mergeSourceAndTarget)
          FilePath
scratchFilePath <-
            Cli (Maybe (FilePath, Bool))
Cli.getLatestFile Cli (Maybe (FilePath, Bool))
-> (Maybe (FilePath, Bool) -> FilePath) -> Cli FilePath
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
              Maybe (FilePath, Bool)
Nothing -> FilePath
"scratch.u"
              Just (FilePath
file, Bool
_) -> FilePath
file
          IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
writeSource (FilePath -> Text
Text.pack FilePath
scratchFilePath) (FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Mergeblob3
blob3.unparsedFile)
          Output -> Cli Mergeblob5
forall a. Output -> Cli a
done (FilePath -> MergeSourceAndTarget -> ProjectBranchName -> Output
Output.MergeFailure FilePath
scratchFilePath MergeSourceAndTarget
mergeSourceAndTarget ProjectBranchName
temporaryBranchName)

      Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
(Var v, Show a) =>
Codebase m v a -> TypecheckedUnisonFile v a -> Transaction ()
Codebase.addDefsToCodebase Env
env.codebase Mergeblob5
blob5.file)
      ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
Cli.updateProjectBranchRoot_
        MergeInfo
info.alice.projectAndBranch.branch
        MergeInfo
info.description
        ( \Branch IO
_aliceBranch ->
            Branch0 IO
-> (CausalHash, IO (Branch IO))
-> (CausalHash, IO (Branch IO))
-> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m
-> (CausalHash, m (Branch m))
-> (CausalHash, m (Branch m))
-> Branch m
Branch.mergeNode
              ( [(Path, Branch0 IO -> Branch0 IO)] -> Branch0 IO -> Branch0 IO
forall (f :: * -> *) (m :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
Branch.batchUpdates
                  (TypecheckedUnisonFile Symbol Ann
-> [(Path, Branch0 IO -> Branch0 IO)]
forall (m :: * -> *).
TypecheckedUnisonFile Symbol Ann
-> [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchAdds Mergeblob5
blob5.file)
                  (Codebase IO Symbol Ann
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 Transaction
-> Branch0 IO
forall v a.
Codebase IO v a
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 Transaction
-> Branch0 IO
defnsAndLibdepsToBranch0 Env
env.codebase Mergeblob3
blob3.stageOne Branch0 Transaction
mergedLibdeps)
              )
              TwoOrThreeWay (CausalHash, IO (Branch IO))
parents.alice
              TwoOrThreeWay (CausalHash, IO (Branch IO))
parents.bob
        )
      pure (MergeSourceAndTarget -> Output
Output.MergeSuccess MergeSourceAndTarget
mergeSourceAndTarget)

  Output -> Cli ()
Cli.respond Output
finalOutput

doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli ()
doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli ()
doMergeLocalBranch TwoWay (ProjectAndBranch Project ProjectBranch)
branches = do
  (CausalHash
aliceCausalHash, CausalHash
bobCausalHash, Maybe CausalHash
lcaCausalHash) <-
    Transaction (CausalHash, CausalHash, Maybe CausalHash)
-> Cli (CausalHash, CausalHash, Maybe CausalHash)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      CausalHash
aliceCausalHash <- ProjectBranch -> Transaction CausalHash
ProjectUtils.getProjectBranchCausalHash (TwoWay (ProjectAndBranch Project ProjectBranch)
branches.alice ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectBranch
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranch
-> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranch
  (ProjectAndBranch Project ProjectBranch)
  ProjectBranch
#branch)
      CausalHash
bobCausalHash <- ProjectBranch -> Transaction CausalHash
ProjectUtils.getProjectBranchCausalHash (TwoWay (ProjectAndBranch Project ProjectBranch)
branches.bob ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectBranch
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranch
-> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranch
  (ProjectAndBranch Project ProjectBranch)
  ProjectBranch
#branch)
      -- Using Alice and Bob's causal hashes, find the LCA (if it exists)
      Maybe CausalHash
lcaCausalHash <- CausalHash -> CausalHash -> Transaction (Maybe CausalHash)
Operations.lca CausalHash
aliceCausalHash CausalHash
bobCausalHash
      pure (CausalHash
aliceCausalHash, CausalHash
bobCausalHash, Maybe CausalHash
lcaCausalHash)

  -- Do the merge!
  MergeInfo -> Cli ()
doMerge
    MergeInfo
      { $sel:alice:MergeInfo :: AliceMergeInfo
alice =
          AliceMergeInfo
            { $sel:causalHash:AliceMergeInfo :: CausalHash
causalHash = CausalHash
aliceCausalHash,
              $sel:projectAndBranch:AliceMergeInfo :: ProjectAndBranch Project ProjectBranch
projectAndBranch = TwoWay (ProjectAndBranch Project ProjectBranch)
branches.alice
            },
        $sel:bob:MergeInfo :: BobMergeInfo
bob =
          BobMergeInfo
            { $sel:causalHash:BobMergeInfo :: CausalHash
causalHash = CausalHash
bobCausalHash,
              $sel:source:BobMergeInfo :: MergeSource
source = MergeTarget -> MergeSource
MergeSource'LocalProjectBranch (ProjectAndBranch Project ProjectBranch -> MergeTarget
ProjectUtils.justTheNames TwoWay (ProjectAndBranch Project ProjectBranch)
branches.bob)
            },
        $sel:lca:MergeInfo :: LcaMergeInfo
lca =
          LcaMergeInfo
            { $sel:causalHash:LcaMergeInfo :: Maybe CausalHash
causalHash = Maybe CausalHash
lcaCausalHash
            },
        $sel:description:MergeInfo :: Text
description = Text
"merge " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectAndBranch Project ProjectBranch -> MergeTarget
ProjectUtils.justTheNames TwoWay (ProjectAndBranch Project ProjectBranch)
branches.bob)
      }

------------------------------------------------------------------------------------------------------------------------
-- Loading basic info out of the database

loadLibdeps ::
  Merge.TwoOrThreeWay (V2.Branch Transaction) ->
  Transaction (Merge.ThreeWay (Map NameSegment (V2.CausalBranch Transaction)))
loadLibdeps :: TwoOrThreeWay (Branch Transaction)
-> Transaction
     (ThreeWay (Map NameSegment (CausalBranch Transaction)))
loadLibdeps TwoOrThreeWay (Branch Transaction)
branches = do
  Map NameSegment (CausalBranch Transaction)
lca <-
    case TwoOrThreeWay (Branch Transaction)
branches.lca of
      Maybe (Branch Transaction)
Nothing -> Map NameSegment (CausalBranch Transaction)
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map NameSegment (CausalBranch Transaction)
forall k a. Map k a
Map.empty
      Just Branch Transaction
lcaBranch -> Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
load Branch Transaction
lcaBranch
  Map NameSegment (CausalBranch Transaction)
alice <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
load TwoOrThreeWay (Branch Transaction)
branches.alice
  Map NameSegment (CausalBranch Transaction)
bob <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
load TwoOrThreeWay (Branch Transaction)
branches.bob
  pure Merge.ThreeWay {Map NameSegment (CausalBranch Transaction)
$sel:lca:ThreeWay :: Map NameSegment (CausalBranch Transaction)
lca :: Map NameSegment (CausalBranch Transaction)
lca, Map NameSegment (CausalBranch Transaction)
$sel:alice:ThreeWay :: Map NameSegment (CausalBranch Transaction)
alice :: Map NameSegment (CausalBranch Transaction)
alice, Map NameSegment (CausalBranch Transaction)
$sel:bob:ThreeWay :: Map NameSegment (CausalBranch Transaction)
bob :: Map NameSegment (CausalBranch Transaction)
bob}
  where
    load :: V2.Branch Transaction -> Transaction (Map NameSegment (V2.CausalBranch Transaction))
    load :: Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
load Branch Transaction
branch =
      case NameSegment
-> Map NameSegment (CausalBranch Transaction)
-> Maybe (CausalBranch Transaction)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
NameSegment.libSegment Branch Transaction
branch.children of
        Maybe (CausalBranch Transaction)
Nothing -> Map NameSegment (CausalBranch Transaction)
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map NameSegment (CausalBranch Transaction)
forall k a. Map k a
Map.empty
        Just CausalBranch Transaction
libdepsCausal -> do
          Branch Transaction
libdepsBranch <- CausalBranch Transaction
libdepsCausal.value
          pure Branch Transaction
libdepsBranch.children

------------------------------------------------------------------------------------------------------------------------
-- Merge precondition violation checks

hasDefnsInLib :: (Applicative m) => V2.Branch m -> m Bool
hasDefnsInLib :: forall (m :: * -> *). Applicative m => Branch m -> m Bool
hasDefnsInLib Branch m
branch = do
  Branch m
libdeps <-
    case NameSegment
-> Map NameSegment (CausalBranch m) -> Maybe (CausalBranch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
NameSegment.libSegment Branch m
branch.children of
      Maybe (CausalBranch m)
Nothing -> Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
forall (m :: * -> *). Branch m
V2.Branch.empty
      Just CausalBranch m
libdeps -> CausalBranch m
libdeps.value
  pure (Bool -> Bool
not (Map NameSegment (Map Referent (m MdValues)) -> Bool
forall k a. Map k a -> Bool
Map.null Branch m
libdeps.terms) Bool -> Bool -> Bool
|| Bool -> Bool
not (Map NameSegment (Map TypeReference (m MdValues)) -> Bool
forall k a. Map k a -> Bool
Map.null Branch m
libdeps.types))

------------------------------------------------------------------------------------------------------------------------
--

defnsAndLibdepsToBranch0 ::
  Codebase IO v a ->
  DefnsF (Map Name) Referent TypeReference ->
  Branch0 Transaction ->
  Branch0 IO
defnsAndLibdepsToBranch0 :: forall v a.
Codebase IO v a
-> DefnsF (Map Name) Referent TypeReference
-> Branch0 Transaction
-> Branch0 IO
defnsAndLibdepsToBranch0 Codebase IO v a
codebase DefnsF (Map Name) Referent TypeReference
defns Branch0 Transaction
libdeps =
  let -- Unflatten the collection of terms into tree, ditto for types
      nametrees :: DefnsF2 Nametree (Map NameSegment) Referent TypeReference
      nametrees :: DefnsF2 Nametree (Map NameSegment) Referent TypeReference
nametrees =
        (Map Name Referent -> Nametree (Map NameSegment Referent))
-> (Map Name TypeReference
    -> Nametree (Map NameSegment TypeReference))
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 Nametree (Map NameSegment) Referent TypeReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name Referent -> Nametree (Map NameSegment Referent)
forall a. Ord a => Map Name a -> Nametree (Map NameSegment a)
unflattenNametree Map Name TypeReference -> Nametree (Map NameSegment TypeReference)
forall a. Ord a => Map Name a -> Nametree (Map NameSegment a)
unflattenNametree DefnsF (Map Name) Referent TypeReference
defns

      -- Align the tree of terms and tree of types into one tree
      nametree :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
      nametree :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree =
        DefnsF2 Nametree (Map NameSegment) Referent TypeReference
nametrees DefnsF2 Nametree (Map NameSegment) Referent TypeReference
-> (DefnsF2 Nametree (Map NameSegment) Referent TypeReference
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall a b. a -> (a -> b) -> b
& (These (Map NameSegment Referent) (Map NameSegment TypeReference)
 -> DefnsF (Map NameSegment) Referent TypeReference)
-> DefnsF2 Nametree (Map NameSegment) Referent TypeReference
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> Defns (f a) (f b) -> f c
alignDefnsWith \case
          This Map NameSegment Referent
terms -> Defns {Map NameSegment Referent
terms :: Map NameSegment Referent
$sel:terms:Defns :: Map NameSegment Referent
terms, $sel:types:Defns :: Map NameSegment TypeReference
types = Map NameSegment TypeReference
forall k a. Map k a
Map.empty}
          That Map NameSegment TypeReference
types -> Defns {$sel:terms:Defns :: Map NameSegment Referent
terms = Map NameSegment Referent
forall k a. Map k a
Map.empty, Map NameSegment TypeReference
$sel:types:Defns :: Map NameSegment TypeReference
types :: Map NameSegment TypeReference
types}
          These Map NameSegment Referent
terms Map NameSegment TypeReference
types -> Map NameSegment Referent
-> Map NameSegment TypeReference
-> DefnsF (Map NameSegment) Referent TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map NameSegment Referent
terms Map NameSegment TypeReference
types

      -- Convert the tree to a branch0
      branch0 :: Branch0 m
branch0 = Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
forall (m :: * -> *).
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Branch0 m
nametreeToBranch0 Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree

      -- Add back the libdeps branch at path "lib"
      branch1 :: Branch0 Transaction
branch1 = NameSegment
-> Branch Transaction -> Branch0 Transaction -> Branch0 Transaction
forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
Branch.setChildBranch NameSegment
NameSegment.libSegment (Branch0 Transaction -> Branch Transaction
forall (m :: * -> *). Branch0 m -> Branch m
Branch.one Branch0 Transaction
libdeps) Branch0 Transaction
forall {m :: * -> *}. Branch0 m
branch0

      -- Awkward: we have a Branch Transaction but we need a Branch IO (because reasons)
      branch2 :: Branch0 IO
branch2 = (forall a. Transaction a -> IO a)
-> Branch0 Transaction -> Branch0 IO
forall (m :: * -> *) (n :: * -> *).
Functor m =>
(forall a. m a -> n a) -> Branch0 m -> Branch0 n
Branch.transform0 (Codebase IO v a -> Transaction a -> IO a
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO v a
codebase) Branch0 Transaction
branch1
   in Branch0 IO
branch2

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

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

findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName
findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName
findTemporaryBranchName ProjectId
projectId MergeSourceAndTarget
mergeSourceAndTarget = do
  ProjectId -> ProjectBranchName -> Transaction ProjectBranchName
ProjectUtils.findTemporaryBranchName ProjectId
projectId ProjectBranchName
preferred
  where
    preferred :: ProjectBranchName
    preferred :: ProjectBranchName
preferred =
      forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text (Text -> ProjectBranchName) -> Text -> ProjectBranchName
forall a b. (a -> b) -> a -> b
$
        Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
          Builder
"merge-"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Builder
mangleMergeSource MergeSourceAndTarget
mergeSourceAndTarget.bob
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-into-"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Builder
mangleBranchName MergeSourceAndTarget
mergeSourceAndTarget.alice.branch

    mangleMergeSource :: MergeSource -> Text.Builder
    mangleMergeSource :: MergeSource -> Builder
mangleMergeSource = \case
      MergeSource'LocalProjectBranch (ProjectAndBranch ProjectName
_project ProjectBranchName
branch) -> ProjectBranchName -> Builder
mangleBranchName ProjectBranchName
branch
      MergeSource'RemoteProjectBranch (ProjectAndBranch ProjectName
_project ProjectBranchName
branch) -> Builder
"remote-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Builder
mangleBranchName ProjectBranchName
branch
      MergeSource'RemoteLooseCode ReadShareLooseCode
info -> Path -> Builder
manglePath ReadShareLooseCode
info.path
    mangleBranchName :: ProjectBranchName -> Text.Builder
    mangleBranchName :: ProjectBranchName -> Builder
mangleBranchName ProjectBranchName
name =
      case ProjectBranchName -> ProjectBranchNameKind
classifyProjectBranchName ProjectBranchName
name of
        ProjectBranchNameKind'Contributor Text
user ProjectBranchName
name1 ->
          Text -> Builder
Text.Builder.text Text
user
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'-'
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Builder
mangleBranchName ProjectBranchName
name1
        ProjectBranchNameKind'DraftRelease Semver
semver -> Builder
"releases-drafts-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Semver -> Builder
mangleSemver Semver
semver
        ProjectBranchNameKind'Release Semver
semver -> Builder
"releases-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Semver -> Builder
mangleSemver Semver
semver
        ProjectBranchNameKind
ProjectBranchNameKind'NothingSpecial -> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
name)

    manglePath :: Path -> Text.Builder
    manglePath :: Path -> Builder
manglePath =
      Builder -> (NameSegment -> Builder) -> [NameSegment] -> Builder
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
Monoid.intercalateMap Builder
"-" (Text -> Builder
Text.Builder.text (Text -> Builder)
-> (NameSegment -> Text) -> NameSegment -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toUnescapedText) ([NameSegment] -> Builder)
-> (Path -> [NameSegment]) -> Path -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [NameSegment]
Path.toList

    mangleSemver :: Semver -> Text.Builder
    mangleSemver :: Semver -> Builder
mangleSemver (Semver Int
x Int
y Int
z) =
      Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
x
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'.'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
y
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'.'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
z

libdepsToBranch0 ::
  (Reference -> Transaction ConstructorType) ->
  Map NameSegment (V2.CausalBranch Transaction) ->
  Transaction (Branch0 Transaction)
libdepsToBranch0 :: (TypeReference -> Transaction ConstructorType)
-> Map NameSegment (CausalBranch Transaction)
-> Transaction (Branch0 Transaction)
libdepsToBranch0 TypeReference -> Transaction ConstructorType
loadDeclType Map NameSegment (CausalBranch Transaction)
libdeps = do
  let branch :: V2.Branch Transaction
      branch :: Branch Transaction
branch =
        V2.Branch
          { $sel:terms:Branch :: Map NameSegment (Map Referent (Transaction MdValues))
terms = Map NameSegment (Map Referent (Transaction MdValues))
forall k a. Map k a
Map.empty,
            $sel:types:Branch :: Map NameSegment (Map TypeReference (Transaction MdValues))
types = Map NameSegment (Map TypeReference (Transaction MdValues))
forall k a. Map k a
Map.empty,
            $sel:patches:Branch :: Map NameSegment (PatchHash, Transaction Patch)
patches = Map NameSegment (PatchHash, Transaction Patch)
forall k a. Map k a
Map.empty,
            $sel:children:Branch :: Map NameSegment (CausalBranch Transaction)
children = Map NameSegment (CausalBranch Transaction)
libdeps
          }

  -- We make a fresh branch cache to load the branch of libdeps.
  -- It would probably be better to reuse the codebase's branch cache.
  -- FIXME how slow/bad is this without that branch cache?
  BranchCache Transaction
branchCache <- IO (BranchCache Transaction)
-> Transaction (BranchCache Transaction)
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO IO (BranchCache Transaction)
forall (m :: * -> *). MonadIO m => m (BranchCache Transaction)
newBranchCache
  BranchCache Transaction
-> (TypeReference -> Transaction ConstructorType)
-> Branch Transaction
-> Transaction (Branch0 Transaction)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (TypeReference -> m ConstructorType)
-> Branch m
-> m (Branch0 m)
Conversions.branch2to1 BranchCache Transaction
branchCache TypeReference -> Transaction ConstructorType
loadDeclType Branch Transaction
branch

typecheckedUnisonFileToBranchAdds :: TypecheckedUnisonFile Symbol Ann -> [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchAdds :: forall (m :: * -> *).
TypecheckedUnisonFile Symbol Ann
-> [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchAdds TypecheckedUnisonFile Symbol Ann
tuf = do
  [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *). [(Path, Branch0 m -> Branch0 m)]
declAdds [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *). [(Path, Branch0 m -> Branch0 m)]
termAdds
  where
    declAdds :: [(Path, Branch0 m -> Branch0 m)]
    declAdds :: forall (m :: * -> *). [(Path, Branch0 m -> Branch0 m)]
declAdds = do
      ((Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
-> [(Path, Branch0 m -> Branch0 m)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
forall {m :: * -> *}.
(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeDataDeclAdds (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UnisonFile.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf))
        [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ ((Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
-> [(Path, Branch0 m -> Branch0 m)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
forall {m :: * -> *}.
(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UnisonFile.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf))
      where
        makeDataDeclAdds :: (Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeDataDeclAdds (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann
dataDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
(Symbol, (TermReferenceId, Decl Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeDeclAdds (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
dataDecl))
        makeEffectDeclUpdates :: (Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann
effectDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
(Symbol, (TermReferenceId, Decl Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeDeclAdds (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left EffectDeclaration Symbol Ann
effectDecl))

        makeDeclAdds :: (Symbol, (TypeReferenceId, Decl Symbol Ann)) -> [(Path, Branch0 m -> Branch0 m)]
        makeDeclAdds :: forall (m :: * -> *).
(Symbol, (TermReferenceId, Decl Symbol Ann))
-> [(Path, Branch0 m -> Branch0 m)]
makeDeclAdds (Symbol
symbol, (TermReferenceId
typeRefId, Decl Symbol Ann
decl)) =
          let insertTypeAction :: (Path, Branch0 m -> Branch0 m)
insertTypeAction = (Path, NameSegment)
-> TypeReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TypeReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName (Symbol -> (Path, NameSegment)
splitVar Symbol
symbol) (TermReferenceId -> TypeReference
Reference.fromId TermReferenceId
typeRefId)
              insertTypeConstructorActions :: [(Path, Branch0 m -> Branch0 m)]
insertTypeConstructorActions =
                (Symbol
 -> Referent' TermReferenceId -> (Path, Branch0 m -> Branch0 m))
-> [Symbol]
-> [Referent' TermReferenceId]
-> [(Path, Branch0 m -> Branch0 m)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
                  (\Symbol
sym Referent' TermReferenceId
rid -> (Path, NameSegment) -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName (Symbol -> (Path, NameSegment)
splitVar Symbol
sym) (TermReferenceId -> TypeReference
Reference.fromId (TermReferenceId -> TypeReference)
-> Referent' TermReferenceId -> Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referent' TermReferenceId
rid))
                  (DataDeclaration Symbol Ann -> [Symbol]
forall v a. DataDeclaration v a -> [v]
DataDeclaration.constructorVars (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DataDeclaration.asDataDecl Decl Symbol Ann
decl))
                  (TermReferenceId -> Decl Symbol Ann -> [Referent' TermReferenceId]
forall v a.
TermReferenceId -> Decl v a -> [Referent' TermReferenceId]
DataDeclaration.declConstructorReferents TermReferenceId
typeRefId Decl Symbol Ann
decl)
           in (Path, Branch0 m -> Branch0 m)
insertTypeAction (Path, Branch0 m -> Branch0 m)
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. a -> [a] -> [a]
: [(Path, Branch0 m -> Branch0 m)]
insertTypeConstructorActions

    termAdds :: [(Path, Branch0 m -> Branch0 m)]
    termAdds :: forall (m :: * -> *). [(Path, Branch0 m -> Branch0 m)]
termAdds =
      TypecheckedUnisonFile Symbol Ann
tuf
        TypecheckedUnisonFile Symbol Ann
-> (TypecheckedUnisonFile Symbol Ann
    -> Map
         Symbol
         (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe FilePath, Term v a, Type v a)
UnisonFile.hashTermsId
        Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> (Map
      Symbol
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann)
    -> [(Symbol,
         (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))])
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))]
-> ([(Symbol,
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann))]
    -> [(Path, Branch0 m -> Branch0 m)])
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. a -> (a -> b) -> b
& ((Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))
 -> Maybe (Path, Branch0 m -> Branch0 m))
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(Symbol
var, (Ann
_, TermReferenceId
ref, Maybe FilePath
wk, Term Symbol Ann
_, Type Symbol Ann
_)) -> do
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe FilePath -> Bool
WatchKind.watchKindShouldBeStoredInDatabase Maybe FilePath
wk)
          (Path, Branch0 m -> Branch0 m)
-> Maybe (Path, Branch0 m -> Branch0 m)
forall a. a -> Maybe a
Just ((Path, NameSegment) -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName (Symbol -> (Path, NameSegment)
splitVar Symbol
var) (TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
ref))

    splitVar :: Symbol -> Path.Split
    splitVar :: Symbol -> (Path, NameSegment)
splitVar = Name -> (Path, NameSegment)
Path.splitFromName (Name -> (Path, NameSegment))
-> (Symbol -> Name) -> Symbol -> (Path, NameSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar

------------------------------------------------------------------------------------------------------------------------
-- Debugging by printing a bunch of stuff out

data DebugFunctions = DebugFunctions
  { DebugFunctions -> TwoOrThreeWay (CausalBranch Transaction) -> IO ()
debugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (),
    DebugFunctions
-> TwoWay
     (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> IO ()
debugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO (),
    DebugFunctions
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> IO ()
debugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO (),
    DebugFunctions
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TypeReference
-> IO ()
debugPartitionedDiff ::
      Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) ->
      DefnsF Merge.Unconflicts Referent TypeReference ->
      IO ()
  }

realDebugFunctions :: DebugFunctions
realDebugFunctions :: DebugFunctions
realDebugFunctions =
  DebugFunctions
    { $sel:debugCausals:DebugFunctions :: TwoOrThreeWay (CausalBranch Transaction) -> IO ()
debugCausals = TwoOrThreeWay (CausalBranch Transaction) -> IO ()
realDebugCausals,
      $sel:debugDiffs:DebugFunctions :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> IO ()
debugDiffs = TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> IO ()
realDebugDiffs,
      $sel:debugCombinedDiff:DebugFunctions :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO ()
debugCombinedDiff = DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO ()
realDebugCombinedDiff,
      $sel:debugPartitionedDiff:DebugFunctions :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TypeReference -> IO ()
debugPartitionedDiff = TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TypeReference -> IO ()
realDebugPartitionedDiff
    }

fakeDebugFunctions :: DebugFunctions
fakeDebugFunctions :: DebugFunctions
fakeDebugFunctions =
  (TwoOrThreeWay (CausalBranch Transaction) -> IO ())
-> (TwoWay
      (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
    -> IO ())
-> (DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
    -> IO ())
-> (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
    -> DefnsF Unconflicts Referent TypeReference -> IO ())
-> DebugFunctions
DebugFunctions TwoOrThreeWay (CausalBranch Transaction) -> IO ()
forall a. Monoid a => a
mempty TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> IO ()
forall a. Monoid a => a
mempty DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO ()
forall a. Monoid a => a
mempty TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TypeReference -> IO ()
forall a. Monoid a => a
mempty

realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO ()
realDebugCausals :: TwoOrThreeWay (CausalBranch Transaction) -> IO ()
realDebugCausals TwoOrThreeWay (CausalBranch Transaction)
causals = do
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Alice causal hash ===")
  Text -> IO ()
Text.putStrLn (Hash -> Text
Hash.toBase32HexText (CausalHash -> Hash
unCausalHash TwoOrThreeWay (CausalBranch Transaction)
causals.alice.causalHash))
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Bob causal hash ===")
  Text -> IO ()
Text.putStrLn (Hash -> Text
Hash.toBase32HexText (CausalHash -> Hash
unCausalHash TwoOrThreeWay (CausalBranch Transaction)
causals.bob.causalHash))
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== LCA causal hash ===")
  Text -> IO ()
Text.putStrLn case TwoOrThreeWay (CausalBranch Transaction)
causals.lca of
    Maybe (CausalBranch Transaction)
Nothing -> Text
"Nothing"
    Just CausalBranch Transaction
causal -> Text
"Just " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash -> Text
Hash.toBase32HexText (CausalHash -> Hash
unCausalHash CausalBranch Transaction
causal.causalHash)

realDebugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO ()
realDebugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
-> IO ()
realDebugDiffs TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffs = do
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== LCA→Alice diff ===")
  DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference -> IO ()
renderDiff TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffs.alice
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== LCA→Bob diff ===")
  DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference -> IO ()
renderDiff TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
diffs.bob
  where
    renderDiff :: DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference -> IO ()
    renderDiff :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference -> IO ()
renderDiff DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diff = do
      (Referent -> Text)
-> Map Name (DiffOp (Synhashed Referent)) -> IO ()
forall ref.
(ref -> Text) -> Map Name (DiffOp (Synhashed ref)) -> IO ()
renderThings Referent -> Text
referentLabel DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diff.terms
      (TypeReference -> Text)
-> Map Name (DiffOp (Synhashed TypeReference)) -> IO ()
forall ref.
(ref -> Text) -> Map Name (DiffOp (Synhashed ref)) -> IO ()
renderThings (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference
diff.types

    renderThings :: (ref -> Text) -> Map Name (Merge.DiffOp (Merge.Synhashed ref)) -> IO ()
    renderThings :: forall ref.
(ref -> Text) -> Map Name (DiffOp (Synhashed ref)) -> IO ()
renderThings ref -> Text
label Map Name (DiffOp (Synhashed ref))
things =
      [(Name, DiffOp (Synhashed ref))]
-> ((Name, DiffOp (Synhashed ref)) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map Name (DiffOp (Synhashed ref))
-> [(Name, DiffOp (Synhashed ref))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name (DiffOp (Synhashed ref))
things) \(Name
name, DiffOp (Synhashed ref)
op) ->
        let go :: (Text -> Text) -> Text -> Synhashed ref -> Text
go Text -> Text
color Text
action Synhashed ref
x =
              Text -> Text
color (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                Text
action
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label (Synhashed ref -> ref
forall a. Synhashed a -> a
Synhashed.value Synhashed ref
x))
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash -> Text
Hash.toBase32HexText (Synhashed ref -> Hash
forall a. Synhashed a -> Hash
Synhashed.hash Synhashed ref
x)
         in Text -> IO ()
Text.putStrLn case DiffOp (Synhashed ref)
op of
              Merge.DiffOp'Add Synhashed ref
x -> (Text -> Text) -> Text -> Synhashed ref -> Text
go Text -> Text
Text.green Text
"+" Synhashed ref
x
              Merge.DiffOp'Delete Synhashed ref
x -> (Text -> Text) -> Text -> Synhashed ref -> Text
go Text -> Text
Text.red Text
"-" Synhashed ref
x
              Merge.DiffOp'Update Updated (Synhashed ref)
x -> (Text -> Text) -> Text -> Synhashed ref -> Text
go Text -> Text
Text.yellow Text
"%" Updated (Synhashed ref)
x.new

realDebugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO ()
realDebugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO ()
realDebugCombinedDiff DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff = do
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Combined diff ===")
  (Referent -> Text)
-> (Referent -> Text)
-> Map Name (CombinedDiffOp Referent)
-> IO ()
forall ref.
(ref -> Text)
-> (ref -> Text) -> Map Name (CombinedDiffOp ref) -> IO ()
renderThings Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff.terms
  (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name (CombinedDiffOp TypeReference)
-> IO ()
forall ref.
(ref -> Text)
-> (ref -> Text) -> Map Name (CombinedDiffOp ref) -> IO ()
renderThings (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff.types
  where
    renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name (Merge.CombinedDiffOp ref) -> IO ()
    renderThings :: forall ref.
(ref -> Text)
-> (ref -> Text) -> Map Name (CombinedDiffOp ref) -> IO ()
renderThings ref -> Text
label ref -> Text
renderRef Map Name (CombinedDiffOp ref)
things =
      [(Name, CombinedDiffOp ref)]
-> ((Name, CombinedDiffOp ref) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map Name (CombinedDiffOp ref) -> [(Name, CombinedDiffOp ref)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name (CombinedDiffOp ref)
things) \(Name
name, CombinedDiffOp ref
op) ->
        Text -> IO ()
Text.putStrLn case CombinedDiffOp ref
op of
          Merge.CombinedDiffOp'Add EitherWayI ref
who ->
            Text -> Text
Text.green (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
              Text
"+ "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label (EitherWayI ref -> ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI ref
who))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef (EitherWayI ref -> ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI ref
who)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EitherWayI ref -> Text
forall v. EitherWayI v -> Text
renderWho EitherWayI ref
who
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Merge.CombinedDiffOp'Delete EitherWayI ref
who ->
            Text -> Text
Text.red (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
              Text
"- "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label (EitherWayI ref -> ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI ref
who))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef (EitherWayI ref -> ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI ref
who)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EitherWayI ref -> Text
forall v. EitherWayI v -> Text
renderWho EitherWayI ref
who
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Merge.CombinedDiffOp'Update EitherWayI (Updated ref)
who ->
            Text -> Text
Text.yellow (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
              Text
"% "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label (EitherWayI (Updated ref) -> Updated ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI (Updated ref)
who).new)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef (EitherWayI (Updated ref) -> Updated ref
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI (Updated ref)
who).new
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EitherWayI (Updated ref) -> Text
forall v. EitherWayI v -> Text
renderWho EitherWayI (Updated ref)
who
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          Merge.CombinedDiffOp'Conflict TwoWay ref
ref ->
            Text -> Text
Text.magenta (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
              Text
"! "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label TwoWay ref
ref.alice)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label TwoWay ref
ref.bob)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef TwoWay ref
ref.alice
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef TwoWay ref
ref.bob

    renderWho :: Merge.EitherWayI v -> Text
    renderWho :: forall v. EitherWayI v -> Text
renderWho = \case
      Merge.OnlyAlice v
_ -> Text
"Alice"
      Merge.OnlyBob v
_ -> Text
"Bob"
      Merge.AliceAndBob v
_ -> Text
"Alice and Bob"

realDebugPartitionedDiff ::
  Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) ->
  DefnsF Merge.Unconflicts Referent TypeReference ->
  IO ()
realDebugPartitionedDiff :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TypeReference -> IO ()
realDebugPartitionedDiff TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts DefnsF Unconflicts Referent TypeReference
unconflicts = do
  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Alice conflicts ===")
  Text -> Map Name TermReferenceId -> EitherWay () -> IO ()
renderConflicts Text
"termid" TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.alice.terms (() -> EitherWay ()
forall a. a -> EitherWay a
Merge.Alice ())
  Text -> Map Name TermReferenceId -> EitherWay () -> IO ()
renderConflicts Text
"typeid" TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.alice.types (() -> EitherWay ()
forall a. a -> EitherWay a
Merge.Alice ())

  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Bob conflicts ===")
  Text -> Map Name TermReferenceId -> EitherWay () -> IO ()
renderConflicts Text
"termid" TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.bob.terms (() -> EitherWay ()
forall a. a -> EitherWay a
Merge.Bob ())
  Text -> Map Name TermReferenceId -> EitherWay () -> IO ()
renderConflicts Text
"typeid" TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.bob.types (() -> EitherWay ()
forall a. a -> EitherWay a
Merge.Bob ())

  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Alice unconflicts ===")
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.adds.alice
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.adds.alice
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.deletes.alice
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.deletes.alice
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.updates.alice
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.updates.alice

  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Bob unconflicts ===")
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.adds.bob
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.adds.bob
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.deletes.bob
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.deletes.bob
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.updates.bob
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.updates.bob

  Text -> IO ()
Text.putStrLn (Text -> Text
Text.bold Text
"\n=== Alice-and-Bob unconflicts ===")
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.adds.both
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.green Text
"+" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.adds.both
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.deletes.both
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.red Text
"-" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.deletes.both
  (Text -> Text)
-> Text
-> (Referent -> Text)
-> (Referent -> Text)
-> Map Name Referent
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" Referent -> Text
referentLabel Referent -> Text
Referent.toText DefnsF Unconflicts Referent TypeReference
unconflicts.terms.updates.both
  (Text -> Text)
-> Text
-> (TypeReference -> Text)
-> (TypeReference -> Text)
-> Map Name TypeReference
-> IO ()
forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
Text.yellow Text
"%" (Text -> TypeReference -> Text
forall a b. a -> b -> a
const Text
"type") TypeReference -> Text
Reference.toText DefnsF Unconflicts Referent TypeReference
unconflicts.types.updates.both
  where
    renderConflicts :: Text -> Map Name Reference.Id -> Merge.EitherWay () -> IO ()
    renderConflicts :: Text -> Map Name TermReferenceId -> EitherWay () -> IO ()
renderConflicts Text
label Map Name TermReferenceId
conflicts EitherWay ()
who =
      [(Name, TermReferenceId)]
-> ((Name, TermReferenceId) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map Name TermReferenceId -> [(Name, TermReferenceId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name TermReferenceId
conflicts) \(Name
name, TermReferenceId
ref) ->
        Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text -> Text
Text.magenta (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            Text
"! "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic Text
label
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TermReferenceId -> Text
Reference.idToText TermReferenceId
ref
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case EitherWay ()
who of Merge.Alice () -> Text
"Alice"; Merge.Bob () -> Text
"Bob")
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

    renderUnconflicts ::
      (Text -> Text) ->
      Text ->
      (ref -> Text) ->
      (ref -> Text) ->
      Map Name ref ->
      IO ()
    renderUnconflicts :: forall ref.
(Text -> Text)
-> Text -> (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
renderUnconflicts Text -> Text
color Text
action ref -> Text
label ref -> Text
renderRef Map Name ref
unconflicts =
      [(Name, ref)] -> ((Name, ref) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map Name ref -> [(Name, ref)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name ref
unconflicts) \(Name
name, ref
ref) ->
        Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text -> Text
color (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            Text
action
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.italic (ref -> Text
label ref
ref)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ref -> Text
renderRef ref
ref

referentLabel :: Referent -> Text
referentLabel :: Referent -> Text
referentLabel Referent
ref
  | Referent -> Bool
forall r. Referent' r -> Bool
Referent'.isConstructor Referent
ref = Text
"constructor"
  | Bool
otherwise = Text
"term"