-- | @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.Algorithm.Diff qualified as Diff
import Data.List qualified as List
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 System.Directory (canonicalizePath, getTemporaryDirectory, removeFile)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.IO.Temp qualified as Temporary
import System.Process qualified as Process
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 (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.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 :: ProjectAndBranch ProjectName ProjectBranchName
aliceBranchNames = ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectName ProjectBranchName
ProjectUtils.justTheNames MergeInfo
info.alice.projectAndBranch
  let mergeSource :: MergeSourceOrTarget
mergeSource = MergeSource -> MergeSourceOrTarget
MergeSourceOrTarget'Source MergeInfo
info.bob.source
  let mergeTarget :: MergeSourceOrTarget
mergeTarget = ProjectAndBranch ProjectName ProjectBranchName
-> MergeSourceOrTarget
MergeSourceOrTarget'Target ProjectAndBranch ProjectName ProjectBranchName
aliceBranchNames
  let mergeSourceAndTarget :: MergeSourceAndTarget
mergeSourceAndTarget = MergeSourceAndTarget {$sel:alice:MergeSourceAndTarget :: ProjectAndBranch ProjectName ProjectBranchName
alice = ProjectAndBranch ProjectName ProjectBranchName
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)

      ((Output -> Cli ()) -> Cli Output) -> Cli Output
forall a. ((Output -> Cli ()) -> Cli a) -> Cli a
Cli.withRespondRegion \Output -> Cli ()
respondRegion -> do
        Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Loading branches...")

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

        Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Computing diff between branches...")

        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)

        Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Loading dependents of changes...")

        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

        Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Loading and merging library dependencies...")

        -- Load libdeps
        (Branch0 Transaction
mergedLibdeps, Branch0 Transaction
lcaLibdeps) <- do
          -- 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?
          Transaction (Branch0 Transaction, Branch0 Transaction)
-> Cli (Branch0 Transaction, Branch0 Transaction)
forall a. Transaction a -> Cli a
Cli.runTransaction do
            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
            let load :: Map NameSegment (CausalBranch Transaction)
-> Transaction (Branch0 Transaction)
load Map NameSegment (CausalBranch Transaction)
children =
                  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
                    (Codebase IO Symbol Ann
-> TypeReference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
Codebase.getDeclType Env
env.codebase)
                    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, Map NameSegment (CausalBranch Transaction)
children :: Map NameSegment (CausalBranch Transaction)
$sel:children:Branch :: Map NameSegment (CausalBranch Transaction)
children}
            Branch0 Transaction
mergedLibdeps <- Map NameSegment (CausalBranch Transaction)
-> Transaction (Branch0 Transaction)
load Mergeblob2 (CausalBranch Transaction)
blob2.libdeps
            Branch0 Transaction
lcaLibdeps <- Map NameSegment (CausalBranch Transaction)
-> Transaction (Branch0 Transaction)
load Mergeblob2 (CausalBranch Transaction)
blob2.lcaLibdeps
            pure (Branch0 Transaction
mergedLibdeps, Branch0 Transaction
lcaLibdeps)

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

        Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Rendering Unison file...")

        let blob3 :: Mergeblob3
blob3 =
              Mergeblob2 (CausalBranch Transaction)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> Names
-> TwoWay Text
-> Mergeblob3
forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> 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)
                (Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 Transaction
lcaLibdeps)
                Merge.TwoWay
                  { $sel:alice:TwoWay :: Text
alice = forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
aliceBranchNames,
                    $sel:bob:TwoWay :: Text
bob =
                      case MergeInfo
info.bob.source of
                        MergeSource'LocalProjectBranch ProjectAndBranch ProjectName ProjectBranchName
bobBranchNames -> forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
bobBranchNames
                        MergeSource'RemoteProjectBranch ProjectAndBranch ProjectName ProjectBranchName
bobBranchNames
                          | ProjectAndBranch ProjectName ProjectBranchName
aliceBranchNames ProjectAndBranch ProjectName ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectAndBranch ProjectName ProjectBranchName
bobBranchNames -> Text
"remote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
bobBranchNames
                          | Bool
otherwise -> forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
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
                Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Typechecking Unison file...")
                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
            Env
env <- 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)

            --   Merge conflicts?    Have UCM_MERGETOOL?    Result
            --   ----------------    -------------------    ------------------------------------------------------------
            --                 No                     No           Put code that doesn't parse or typecheck in scratch.u
            --                 No                    Yes           Put code that doesn't parse or typecheck in scratch.u
            --                Yes                     No    Put code that doesn't parse (because conflicts) in scratch.u
            --                Yes                    Yes                                              Run that cool tool

            Maybe FilePath
maybeMergetool <-
              if Bool
hasConflicts
                then IO (Maybe FilePath) -> Cli (Maybe FilePath)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"UCM_MERGETOOL")
                else Maybe FilePath -> Cli (Maybe FilePath)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing

            case Maybe FilePath
maybeMergetool of
              Maybe FilePath
Nothing -> do
                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
$ Env
env.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) Bool
True
                Output -> Cli Mergeblob5
forall a. Output -> Cli a
done (FilePath -> MergeSourceAndTarget -> ProjectBranchName -> Output
Output.MergeFailure FilePath
scratchFilePath MergeSourceAndTarget
mergeSourceAndTarget ProjectBranchName
temporaryBranchName)
              Just FilePath
mergetool0 -> do
                let aliceFilenameSlug :: Builder
aliceFilenameSlug = ProjectBranchName -> Builder
mangleBranchName MergeSourceAndTarget
mergeSourceAndTarget.alice.branch
                let bobFilenameSlug :: Builder
bobFilenameSlug = MergeSource -> Builder
mangleMergeSource MergeSourceAndTarget
mergeSourceAndTarget.bob
                Builder -> Text
makeTempFilename <-
                  IO (Builder -> Text) -> Cli (Builder -> Text)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
                    FilePath
tmpdir0 <- IO FilePath
getTemporaryDirectory
                    FilePath
tmpdir1 <- FilePath -> IO FilePath
canonicalizePath FilePath
tmpdir0
                    FilePath
tmpdir2 <- FilePath -> FilePath -> IO FilePath
Temporary.createTempDirectory FilePath
tmpdir1 FilePath
"unison-merge"
                    pure \Builder
filename -> FilePath -> Text
Text.pack (FilePath
tmpdir2 FilePath -> FilePath -> FilePath
</> Text -> FilePath
Text.unpack (Builder -> Text
Text.Builder.run Builder
filename))
                let lcaFilename :: Text
lcaFilename = Builder -> Text
makeTempFilename (Builder
aliceFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bobFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-base.u")
                let aliceFilename :: Text
aliceFilename = Builder -> Text
makeTempFilename (Builder
aliceFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u")
                let bobFilename :: Text
bobFilename = Builder -> Text
makeTempFilename (Builder
bobFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u")
                let mergedFilename :: Text
mergedFilename = Builder -> Text
Text.Builder.run (Builder
aliceFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bobFilenameSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-merged.u")
                let mergetool :: Text
mergetool =
                      FilePath
mergetool0
                        FilePath -> (FilePath -> Text) -> Text
forall a b. a -> (a -> b) -> b
& FilePath -> Text
Text.pack
                        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$BASE" Text
lcaFilename
                        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$LOCAL" Text
aliceFilename
                        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$MERGED" Text
mergedFilename
                        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$REMOTE" Text
bobFilename
                ExitCode
exitCode <-
                  IO ExitCode -> Cli ExitCode
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
                    let aliceFileContents :: Text
aliceFileContents = FilePath -> Text
Text.pack (Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Mergeblob3
blob3.unparsedSoloFiles.alice)
                    let bobFileContents :: Text
bobFileContents = FilePath -> Text
Text.pack (Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Mergeblob3
blob3.unparsedSoloFiles.bob)
                    FilePath -> IO ()
removeFile (Text -> FilePath
Text.unpack Text
mergedFilename) IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Env
env.writeSource Text
lcaFilename (FilePath -> Text
Text.pack (Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Mergeblob3
blob3.unparsedSoloFiles.lca)) Bool
True
                    Env
env.writeSource Text
aliceFilename Text
aliceFileContents Bool
True
                    Env
env.writeSource Text
bobFilename Text
bobFileContents Bool
True
                    Env
env.writeSource
                      Text
mergedFilename
                      ( MergeSourceAndTarget -> Text -> Text -> Text
makeMergedFileContents
                          MergeSourceAndTarget
mergeSourceAndTarget
                          Text
aliceFileContents
                          Text
bobFileContents
                      )
                      Bool
True
                    let createProcess :: CreateProcess
createProcess = (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Text.unpack Text
mergetool)) {Process.delegate_ctlc = True}
                    CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
Process.withCreateProcess CreateProcess
createProcess \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ -> ProcessHandle -> IO ExitCode
Process.waitForProcess
                Output -> Cli Mergeblob5
forall a. Output -> Cli a
done (MergeSourceAndTarget
-> ProjectBranchName -> Text -> ExitCode -> Output
Output.MergeFailureWithMergetool MergeSourceAndTarget
mergeSourceAndTarget ProjectBranchName
temporaryBranchName Text
mergetool ExitCode
exitCode)

        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 = ProjectAndBranch ProjectName ProjectBranchName -> MergeSource
MergeSource'LocalProjectBranch (ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectName ProjectBranchName
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
-> ProjectAndBranch ProjectName ProjectBranchName
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
  where
    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

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

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

------------------------------------------------------------------------------------------------------------------------
-- Making file with conflict markers

makeMergedFileContents :: MergeSourceAndTarget -> Text -> Text -> Text
makeMergedFileContents :: MergeSourceAndTarget -> Text -> Text -> Text
makeMergedFileContents MergeSourceAndTarget
sourceAndTarget Text
aliceContents Text
bobContents =
  let f :: (Text.Builder, Diff.Diff Text) -> Diff.Diff Text -> (Text.Builder, Diff.Diff Text)
      f :: (Builder, Diff Text) -> Diff Text -> (Builder, Diff Text)
f (Builder
acc, Diff Text
previous) Diff Text
line =
        case (Diff Text
previous, Diff Text
line) of
          (Diff.Both {}, Diff.Both Text
bothLine Text
_) -> Builder -> (Builder, Diff Text)
go (Text -> Builder
Text.Builder.text Text
bothLine)
          (Diff.Both {}, Diff.First Text
aliceLine) -> Builder -> (Builder, Diff Text)
go (Builder
aliceSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
aliceLine)
          (Diff.Both {}, Diff.Second Text
bobLine) -> Builder -> (Builder, Diff Text)
go (Builder
aliceSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
middleSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
bobLine)
          (Diff.First {}, Diff.Both Text
bothLine Text
_) -> Builder -> (Builder, Diff Text)
go (Builder
middleSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bobSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
bothLine)
          (Diff.First {}, Diff.First Text
aliceLine) -> Builder -> (Builder, Diff Text)
go (Text -> Builder
Text.Builder.text Text
aliceLine)
          (Diff.First {}, Diff.Second Text
bobLine) -> Builder -> (Builder, Diff Text)
go (Builder
middleSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
bobLine)
          (Diff.Second {}, Diff.Both Text
bothLine Text
_) -> Builder -> (Builder, Diff Text)
go (Builder
bobSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
bothLine)
          (Diff.Second {}, Diff.First Text
aliceLine) -> Builder -> (Builder, Diff Text)
go (Builder
bobSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
aliceSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
aliceLine)
          (Diff.Second {}, Diff.Second Text
bobLine) -> Builder -> (Builder, Diff Text)
go (Text -> Builder
Text.Builder.text Text
bobLine)
        where
          go :: Builder -> (Builder, Diff Text)
go Builder
content =
            let !acc1 :: Builder
acc1 = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
content Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
             in (Builder
acc1, Diff Text
line)
   in [Text] -> [Text] -> [Diff Text]
forall a. Eq a => [a] -> [a] -> [Diff a]
Diff.getDiff (Text -> [Text]
Text.lines Text
aliceContents) (Text -> [Text]
Text.lines Text
bobContents)
        [Diff Text]
-> ([Diff Text] -> (Builder, Diff Text)) -> (Builder, Diff Text)
forall a b. a -> (a -> b) -> b
& ((Builder, Diff Text) -> Diff Text -> (Builder, Diff Text))
-> (Builder, Diff Text) -> [Diff Text] -> (Builder, Diff Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Builder, Diff Text) -> Diff Text -> (Builder, Diff Text)
f (forall a. Monoid a => a
mempty @Text.Builder, Text -> Text -> Diff Text
forall a b. a -> b -> PolyDiff a b
Diff.Both Text
Text.empty Text
Text.empty)
        (Builder, Diff Text)
-> ((Builder, Diff Text) -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
& (Builder, Diff Text) -> Builder
forall a b. (a, b) -> a
fst
        Builder -> (Builder -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Builder -> Text
Text.Builder.run
  where
    aliceSlug :: Text.Builder
    aliceSlug :: Builder
aliceSlug =
      Builder
"<<<<<<< " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text MergeSourceAndTarget
sourceAndTarget.alice.branch) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline

    middleSlug :: Text.Builder
    middleSlug :: Builder
middleSlug = Builder
"=======\n"

    bobSlug :: Text.Builder
    bobSlug :: Builder
bobSlug =
      Builder
">>>>>>> "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case MergeSourceAndTarget
sourceAndTarget.bob of
               MergeSource'LocalProjectBranch ProjectAndBranch ProjectName ProjectBranchName
bobProjectAndBranch ->
                 Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
bobProjectAndBranch.branch)
               MergeSource'RemoteProjectBranch ProjectAndBranch ProjectName ProjectBranchName
bobProjectAndBranch ->
                 Builder
"remote " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
bobProjectAndBranch.branch)
               MergeSource'RemoteLooseCode ReadShareLooseCode
info ->
                 case Path -> Maybe Name
Path.toName ReadShareLooseCode
info.path of
                   Maybe Name
Nothing -> Builder
"<root>"
                   Just Name
name -> Text -> Builder
Text.Builder.text (Name -> Text
Name.toText Name
name)
           )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline

    newline :: Text.Builder
    newline :: Builder
newline = Builder
"\n"

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