module Unison.Codebase.Editor.HandleInput.DiffBranch
  ( handleDiffBranch,
  )
where

import Control.Lens (mapped, preview)
import Control.Monad.Reader (ask)
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These (These (..))
import System.Environment (lookupEnv)
import System.Process qualified as Process
import Text.Builder qualified
import Text.Builder qualified as Text (Builder)
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Reference qualified as Reference
import U.Codebase.Sqlite.Operations qualified as Operations
import U.Codebase.Sqlite.Project qualified as Sqlite
import Unison.Builtin qualified as Builtin
import Unison.Cli.DirectoryUtils (makeMakeTempFilename)
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty (prettyCausalHash, prettyLibdepName)
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Cli.UpdateUtils qualified as UpdateUtils
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.BuiltinAnnotation (builtinAnnotation)
import Unison.Codebase.Editor.Input (DiffBranchArg (..))
import Unison.Codebase.Editor.Output (Output)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.ShortCausalHash qualified as ShortCausalHash
import Unison.DataDeclaration (Decl, DeclOrBuiltin)
import Unison.DeclCoherencyCheck (asOneRandomIncoherentDeclReason)
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.Merge qualified as Merge
import Unison.Merge.DiffOp qualified as Merge.DiffOp
import Unison.Merge.Diffblob qualified as Merge
import Unison.Merge.ThreeWay qualified as Merge.ThreeWay
import Unison.Merge.TwoOrThreeWay qualified as Merge.TwoOrThreeWay
import Unison.Merge.TwoWay qualified as Merge.TwoWay
import Unison.Merge.Updated qualified as Merge.Updated
import Unison.Name (Name)
import Unison.NameSegment (NameSegment)
import Unison.NamesUtils qualified as NamesUtils
import Unison.OrBuiltin (OrBuiltin (..))
import Unison.Parser.Ann (Ann)
import Unison.PartialDeclNameLookup qualified as PartialDeclNameLookup
import Unison.Prelude
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.Project (ProjectAndBranch (..), projectBranchNameToValidProjectBranchNameText)
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.FilePrinter qualified as FilePrinter
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.NamePrinter qualified as NamePrinter
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.Util.Alphabetical (sortAlphabeticallyOn)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.ColorText (ColorText)
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF3, zipDefnsWith)
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set
import Unison.Var (Var)

handleDiffBranch :: DiffBranchArg -> DiffBranchArg -> Cli ()
handleDiffBranch :: DiffBranchArg -> DiffBranchArg -> Cli ()
handleDiffBranch DiffBranchArg
aliceArg DiffBranchArg
bobArg = do
  let originalArgs :: TwoWay DiffBranchArg
originalArgs = Merge.TwoWay {$sel:alice:TwoWay :: DiffBranchArg
alice = DiffBranchArg
aliceArg, $sel:bob:TwoWay :: DiffBranchArg
bob = DiffBranchArg
bobArg}

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

  Project
currentProject <- Cli Project
Cli.getCurrentProject

  (TwoOrThreeWay (Branch0 Transaction)
namespaces, Diffblob (Branch Transaction)
diffblob, Bool
swapped) <-
    ((forall void. Output -> Transaction void)
 -> Transaction
      (TwoOrThreeWay (Branch0 Transaction),
       Diffblob (Branch Transaction), Bool))
-> Cli
     (TwoOrThreeWay (Branch0 Transaction),
      Diffblob (Branch Transaction), Bool)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
abort -> do
      TwoWay CausalHash
causalHashes2 <-
        (DiffBranchArg -> Transaction CausalHash)
-> TwoWay DiffBranchArg -> Transaction (TwoWay CausalHash)
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) -> TwoWay a -> f (TwoWay b)
traverse ((forall void. Output -> Transaction void)
-> Project -> DiffBranchArg -> Transaction CausalHash
resolveDiffBranchArg Output -> Transaction void
forall void. Output -> Transaction void
abort Project
currentProject) TwoWay DiffBranchArg
originalArgs

      -- If the causal hashes are the same, there's certainly no diff to show
      Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((CausalHash -> CausalHash -> Bool) -> TwoWay CausalHash -> Bool
forall a b. (a -> a -> b) -> TwoWay a -> b
Merge.TwoWay.twoWay CausalHash -> CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
(==) TwoWay CausalHash
causalHashes2) do
        Output -> Transaction ()
forall void. Output -> Transaction void
abort Output
Output.ShowEmptyBranchDiff

      Maybe CausalHash
maybeLcaCausalHash <-
        CausalHash -> CausalHash -> Transaction (Maybe CausalHash)
Operations.lca TwoWay CausalHash
causalHashes2.alice TwoWay CausalHash
causalHashes2.bob

      -- From now on, all throughout the algorithm, a missing LCA means one of two things, which we treat uniformly:
      --
      --   1. The LCA is Alice, i.e. this is is a fast-forward to Bob
      --   2. The LCA is actually missing, i.e. the branches don't share a history
      --
      -- In both cases, we treat Alice as the effective LCA for the purpose of the diff. (In the no-history case, this
      -- allows users to see the diff between e.g. two squashed releases, in a readable/intuitive way, so long as they
      -- put the older release first on the command line.
      --
      -- You might wonder: what if the LCA is actually Bob, and Alice is ahead? We track that with a separate boolean,
      -- "swapped". If swapped, we're treating Alice as Bob and vice-versa, so just before displaying the diff, we swap
      -- them back. So, this case is also (1).
      let causalHashes :: Merge.TwoOrThreeWay CausalHash
          swapped :: Bool
          (TwoOrThreeWay CausalHash
causalHashes, Bool
swapped) =
            case Maybe CausalHash
maybeLcaCausalHash of
              Maybe CausalHash
Nothing -> (Maybe CausalHash -> TwoWay CausalHash -> TwoOrThreeWay CausalHash
forall a. Maybe a -> TwoWay a -> TwoOrThreeWay a
Merge.TwoWay.toTwoOrThreeWay Maybe CausalHash
forall a. Maybe a
Nothing TwoWay CausalHash
causalHashes2, Bool
False)
              Just CausalHash
lcaCausalHash
                | CausalHash
lcaCausalHash CausalHash -> CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== TwoWay CausalHash
causalHashes2.alice ->
                    (Maybe CausalHash -> TwoWay CausalHash -> TwoOrThreeWay CausalHash
forall a. Maybe a -> TwoWay a -> TwoOrThreeWay a
Merge.TwoWay.toTwoOrThreeWay Maybe CausalHash
forall a. Maybe a
Nothing TwoWay CausalHash
causalHashes2, Bool
False)
                | CausalHash
lcaCausalHash CausalHash -> CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== TwoWay CausalHash
causalHashes2.bob ->
                    (Maybe CausalHash -> TwoWay CausalHash -> TwoOrThreeWay CausalHash
forall a. Maybe a -> TwoWay a -> TwoOrThreeWay a
Merge.TwoWay.toTwoOrThreeWay Maybe CausalHash
forall a. Maybe a
Nothing (TwoWay CausalHash -> TwoWay CausalHash
forall a. TwoWay a -> TwoWay a
Merge.TwoWay.swap TwoWay CausalHash
causalHashes2), Bool
True)
                | Bool
otherwise -> (Maybe CausalHash -> TwoWay CausalHash -> TwoOrThreeWay CausalHash
forall a. Maybe a -> TwoWay a -> TwoOrThreeWay a
Merge.TwoWay.toTwoOrThreeWay Maybe CausalHash
maybeLcaCausalHash TwoWay CausalHash
causalHashes2, Bool
False)

      TwoOrThreeWay (Branch Transaction)
namespaces <-
        TwoOrThreeWay CausalHash
-> (CausalHash -> Transaction (Branch Transaction))
-> Transaction (TwoOrThreeWay (Branch Transaction))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for TwoOrThreeWay CausalHash
causalHashes (Codebase IO Symbol Ann
-> CausalHash -> Transaction (Branch Transaction)
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> Transaction (Branch Transaction)
Codebase.expectBranchForHashTx Env
env.codebase)

      let namespaces0 :: TwoOrThreeWay (Branch0 Transaction)
namespaces0 =
            Branch Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch Transaction -> Branch0 Transaction)
-> TwoOrThreeWay (Branch Transaction)
-> TwoOrThreeWay (Branch0 Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoOrThreeWay (Branch Transaction)
namespaces

      TwoOrThreeWay UnconflictedLocalDefnsView
defns <-
        TwoOrThreeWay (Branch0 Transaction)
-> (Branch0 Transaction -> Transaction UnconflictedLocalDefnsView)
-> Transaction (TwoOrThreeWay UnconflictedLocalDefnsView)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for TwoOrThreeWay (Branch0 Transaction)
namespaces0 \Branch0 Transaction
namespace ->
          Branch0 Transaction
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
Branch.asUnconflicted Branch0 Transaction
namespace
            Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  UnconflictedLocalDefnsView
-> (Either
      (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
      UnconflictedLocalDefnsView
    -> Transaction UnconflictedLocalDefnsView)
-> Transaction UnconflictedLocalDefnsView
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Transaction UnconflictedLocalDefnsView)
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
-> Transaction UnconflictedLocalDefnsView
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft (Output -> Transaction UnconflictedLocalDefnsView
forall void. Output -> Transaction void
abort (Output -> Transaction UnconflictedLocalDefnsView)
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Output)
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Transaction UnconflictedLocalDefnsView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Output
Output.ConflictedDefn)

      TwoWay DeclNameLookup
declNameLookups2 :: Merge.TwoWay DeclNameLookup <-
        TwoWay (Transaction DeclNameLookup)
-> Transaction (TwoWay DeclNameLookup)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => TwoWay (m a) -> m (TwoWay a)
sequence (TwoWay (Transaction DeclNameLookup)
 -> Transaction (TwoWay DeclNameLookup))
-> TwoWay (Transaction DeclNameLookup)
-> Transaction (TwoWay DeclNameLookup)
forall a b. (a -> b) -> a -> b
$
          ( \Branch Transaction
x UnconflictedLocalDefnsView
y DiffBranchArg
z ->
              Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
Codebase.getBranchDeclNameLookup Env
env.codebase (Branch Transaction -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch Transaction
x) UnconflictedLocalDefnsView
y
                Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> (Transaction (Either IncoherentDeclReasons DeclNameLookup)
    -> Transaction DeclNameLookup)
-> Transaction DeclNameLookup
forall a b. a -> (a -> b) -> b
& (IncoherentDeclReasons -> Transaction DeclNameLookup)
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> Transaction DeclNameLookup
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM
                  ( Output -> Transaction DeclNameLookup
forall void. Output -> Transaction void
abort
                      (Output -> Transaction DeclNameLookup)
-> (IncoherentDeclReasons -> Output)
-> IncoherentDeclReasons
-> Transaction DeclNameLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffBranchArg -> IncoherentDeclReason -> Output
Output.IncoherentDeclDuringDiffBranch DiffBranchArg
z
                      (IncoherentDeclReason -> Output)
-> (IncoherentDeclReasons -> IncoherentDeclReason)
-> IncoherentDeclReasons
-> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IncoherentDeclReasons -> IncoherentDeclReason
asOneRandomIncoherentDeclReason
                  )
          )
            (Branch Transaction
 -> UnconflictedLocalDefnsView
 -> DiffBranchArg
 -> Transaction DeclNameLookup)
-> TwoWay (Branch Transaction)
-> TwoWay
     (UnconflictedLocalDefnsView
      -> DiffBranchArg -> Transaction DeclNameLookup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoOrThreeWay (Branch Transaction) -> TwoWay (Branch Transaction)
forall a. TwoOrThreeWay a -> TwoWay a
Merge.TwoOrThreeWay.forgetLca TwoOrThreeWay (Branch Transaction)
namespaces
            TwoWay
  (UnconflictedLocalDefnsView
   -> DiffBranchArg -> Transaction DeclNameLookup)
-> TwoWay UnconflictedLocalDefnsView
-> TwoWay (DiffBranchArg -> Transaction DeclNameLookup)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoOrThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. TwoOrThreeWay a -> TwoWay a
Merge.TwoOrThreeWay.forgetLca TwoOrThreeWay UnconflictedLocalDefnsView
defns
            TwoWay (DiffBranchArg -> Transaction DeclNameLookup)
-> TwoWay DiffBranchArg -> TwoWay (Transaction DeclNameLookup)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if Bool
swapped then TwoWay DiffBranchArg -> TwoWay DiffBranchArg
forall a. TwoWay a -> TwoWay a
Merge.TwoWay.swap TwoWay DiffBranchArg
originalArgs else TwoWay DiffBranchArg
originalArgs)

      Diffblob (Branch Transaction)
diffblob <-
        -- These are all Just or all Nothing
        case (TwoOrThreeWay (Branch Transaction)
namespaces.lca, TwoOrThreeWay UnconflictedLocalDefnsView
defns.lca) of
          (Just Branch Transaction
lcaNamespace, Just UnconflictedLocalDefnsView
lcaDefns) -> do
            let namespaces0' :: ThreeWay (Branch0 Transaction)
namespaces0' = Branch0 Transaction
-> TwoOrThreeWay (Branch0 Transaction)
-> ThreeWay (Branch0 Transaction)
forall a. a -> TwoOrThreeWay a -> ThreeWay a
Merge.TwoOrThreeWay.toThreeWay (Branch Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch Transaction
lcaNamespace) TwoOrThreeWay (Branch0 Transaction)
namespaces0
            PartialDeclNameLookup
lcaDeclNameLookup <-
              Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction PartialDeclNameLookup
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction PartialDeclNameLookup
Codebase.getBranchPartialDeclNameLookup Env
env.codebase (Branch Transaction -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch Transaction
lcaNamespace) UnconflictedLocalDefnsView
lcaDefns
            DiffblobLog Transaction
-> (ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
    -> Transaction
         (Defns
            (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
            (Map TermReferenceId (Decl Symbol Ann))))
-> (ThreeWay (Set LabeledDependency)
    -> Transaction (ThreeWay Names))
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay (Map NameSegment (Branch Transaction))
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> Transaction (Diffblob (Branch Transaction))
forall libdep (m :: * -> *).
(Eq libdep, Monad m) =>
DiffblobLog m
-> (ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
    -> m (Defns
            (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
            (Map TermReferenceId (Decl Symbol Ann))))
-> (ThreeWay (Set LabeledDependency) -> m (ThreeWay Names))
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay (Map NameSegment libdep)
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> m (Diffblob libdep)
Merge.makeDiffblob
              DiffblobLog Transaction
forall (m :: * -> *). Applicative m => DiffblobLog m
Merge.emptyDiffblobLog
              (Codebase IO Symbol Ann
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term v a, Type v a))
        (Map TermReferenceId (Decl v a)))
UpdateUtils.hydrateRefs Env
env.codebase (DefnsF Set TermReferenceId TermReferenceId
 -> Transaction
      (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
    -> DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Set TermReferenceId TermReferenceId
forall m. Monoid m => ThreeWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold)
              (\ThreeWay (Set LabeledDependency)
_ -> ThreeWay Names -> Transaction (ThreeWay Names)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 Transaction -> Names)
-> ThreeWay (Branch0 Transaction) -> ThreeWay Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (Branch0 Transaction)
namespaces0'))
              (UnconflictedLocalDefnsView
-> TwoOrThreeWay UnconflictedLocalDefnsView
-> ThreeWay UnconflictedLocalDefnsView
forall a. a -> TwoOrThreeWay a -> ThreeWay a
Merge.TwoOrThreeWay.toThreeWay UnconflictedLocalDefnsView
lcaDefns TwoOrThreeWay UnconflictedLocalDefnsView
defns)
              (Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
-> Branch0 Transaction -> Map NameSegment (Branch Transaction)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
forall (m :: * -> *) (f :: * -> *).
Applicative f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.libdeps_ (Branch0 Transaction -> Map NameSegment (Branch Transaction))
-> ThreeWay (Branch0 Transaction)
-> ThreeWay (Map NameSegment (Branch Transaction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (Branch0 Transaction)
namespaces0')
              (PartialDeclNameLookup
-> TwoWay DeclNameLookup
-> GThreeWay PartialDeclNameLookup DeclNameLookup
forall a b. a -> TwoWay b -> GThreeWay a b
Merge.TwoWay.gtoThreeWay PartialDeclNameLookup
lcaDeclNameLookup TwoWay DeclNameLookup
declNameLookups2)
          (Maybe (Branch Transaction), Maybe UnconflictedLocalDefnsView)
_ ->
            let f :: Merge.TwoOrThreeWay a -> Merge.Updated a
                f :: forall a. TwoOrThreeWay a -> Updated a
f TwoOrThreeWay a
x =
                  a -> a -> GUpdated a a
forall a b. a -> b -> GUpdated a b
Merge.Updated TwoOrThreeWay a
x.alice TwoOrThreeWay a
x.bob
             in (Updated (DefnsF Set TermReferenceId TermReferenceId)
 -> Transaction
      (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (Updated (Set LabeledDependency) -> Transaction (Updated Names))
-> Updated UnconflictedLocalDefnsView
-> Updated (Map NameSegment (Branch Transaction))
-> Updated DeclNameLookup
-> Transaction (Diffblob (Branch Transaction))
forall libdep (m :: * -> *).
(Eq libdep, Monad m) =>
(Updated (DefnsF Set TermReferenceId TermReferenceId)
 -> m (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (Updated (Set LabeledDependency) -> m (Updated Names))
-> Updated UnconflictedLocalDefnsView
-> Updated (Map NameSegment libdep)
-> Updated DeclNameLookup
-> m (Diffblob libdep)
Merge.makeFastForwardDiffblob
                  (Codebase IO Symbol Ann
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term v a, Type v a))
        (Map TermReferenceId (Decl v a)))
UpdateUtils.hydrateRefs Env
env.codebase (DefnsF Set TermReferenceId TermReferenceId
 -> Transaction
      (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (Updated (DefnsF Set TermReferenceId TermReferenceId)
    -> DefnsF Set TermReferenceId TermReferenceId)
-> Updated (DefnsF Set TermReferenceId TermReferenceId)
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Updated (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Set TermReferenceId TermReferenceId
forall a. Semigroup a => Updated a -> a
Merge.Updated.fold)
                  (\Updated (Set LabeledDependency)
_ -> Updated Names -> Transaction (Updated Names)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Branch0 Transaction -> Names)
-> Updated (Branch0 Transaction) -> Updated Names
forall a b. (a -> b) -> Updated a -> Updated b
Merge.Updated.map Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (TwoOrThreeWay (Branch0 Transaction)
-> Updated (Branch0 Transaction)
forall a. TwoOrThreeWay a -> Updated a
f TwoOrThreeWay (Branch0 Transaction)
namespaces0)))
                  (TwoOrThreeWay UnconflictedLocalDefnsView
-> Updated UnconflictedLocalDefnsView
forall a. TwoOrThreeWay a -> Updated a
f TwoOrThreeWay UnconflictedLocalDefnsView
defns)
                  ((Branch0 Transaction -> Map NameSegment (Branch Transaction))
-> Updated (Branch0 Transaction)
-> Updated (Map NameSegment (Branch Transaction))
forall a b. (a -> b) -> Updated a -> Updated b
Merge.Updated.map (Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
-> Branch0 Transaction -> Map NameSegment (Branch Transaction)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
forall (m :: * -> *) (f :: * -> *).
Applicative f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.libdeps_) (TwoOrThreeWay (Branch0 Transaction)
-> Updated (Branch0 Transaction)
forall a. TwoOrThreeWay a -> Updated a
f TwoOrThreeWay (Branch0 Transaction)
namespaces0))
                  ((DeclNameLookup -> DeclNameLookup -> Updated DeclNameLookup)
-> TwoWay DeclNameLookup -> Updated DeclNameLookup
forall a b. (a -> a -> b) -> TwoWay a -> b
Merge.TwoWay.twoWay DeclNameLookup -> DeclNameLookup -> Updated DeclNameLookup
forall a b. a -> b -> GUpdated a b
Merge.Updated TwoWay DeclNameLookup
declNameLookups2)

      (TwoOrThreeWay (Branch0 Transaction),
 Diffblob (Branch Transaction), Bool)
-> Transaction
     (TwoOrThreeWay (Branch0 Transaction),
      Diffblob (Branch Transaction), Bool)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TwoOrThreeWay (Branch0 Transaction)
namespaces0, Diffblob (Branch Transaction)
diffblob, Bool
swapped)

  let maybeSwap :: Merge.TwoWay a -> Merge.TwoWay a
      maybeSwap :: forall a. TwoWay a -> TwoWay a
maybeSwap
        | Bool
swapped = TwoWay a -> TwoWay a
forall a. TwoWay a -> TwoWay a
Merge.TwoWay.swap
        | Bool
otherwise = TwoWay a -> TwoWay a
forall a. a -> a
id

  -- Identify the set of all names changed (added, deleted, updated) on both branches.
  let changedNames :: DefnsF Set Name Name
      changedNames :: DefnsF Set Name Name
changedNames =
        (Defns
   (Map Name (DiffOp (Synhashed Referent)))
   (Map Name (DiffOp (Synhashed TypeReference)))
 -> DefnsF Set Name Name)
-> TwoWay
     (Defns
        (Map Name (DiffOp (Synhashed Referent)))
        (Map Name (DiffOp (Synhashed TypeReference))))
-> DefnsF Set Name Name
forall m a. Monoid m => (a -> m) -> TwoWay a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Map Name (DiffOp (Synhashed Referent)) -> Set Name)
-> (Map Name (DiffOp (Synhashed TypeReference)) -> Set Name)
-> Defns
     (Map Name (DiffOp (Synhashed Referent)))
     (Map Name (DiffOp (Synhashed TypeReference)))
-> DefnsF Set Name Name
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 (DiffOp (Synhashed Referent)) -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name (DiffOp (Synhashed TypeReference)) -> Set Name
forall k a. Map k a -> Set k
Map.keysSet) Diffblob (Branch Transaction)
diffblob.diffsFromLCA

  -- Restrict all definitions to just those changed names (regardless of which branch changed it)
  let changedDefns :: Merge.TwoOrThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
      changedDefns :: TwoOrThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
changedDefns =
        ( if Maybe (Branch0 Transaction) -> Bool
forall a. Maybe a -> Bool
isJust TwoOrThreeWay (Branch0 Transaction)
namespaces.lca
            then
              Diffblob (Branch Transaction)
diffblob.defns
                ThreeWay UnconflictedLocalDefnsView
-> (ThreeWay UnconflictedLocalDefnsView
    -> TwoOrThreeWay UnconflictedLocalDefnsView)
-> TwoOrThreeWay UnconflictedLocalDefnsView
forall a b. a -> (a -> b) -> b
& ThreeWay UnconflictedLocalDefnsView
-> TwoOrThreeWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoOrThreeWay a
Merge.ThreeWay.toTwoOrThreeWay
            else
              Diffblob (Branch Transaction)
diffblob.defns
                ThreeWay UnconflictedLocalDefnsView
-> (ThreeWay UnconflictedLocalDefnsView
    -> TwoWay UnconflictedLocalDefnsView)
-> TwoWay UnconflictedLocalDefnsView
forall a b. a -> (a -> b) -> b
& ThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoWay a
Merge.ThreeWay.forgetLca
                TwoWay UnconflictedLocalDefnsView
-> (TwoWay UnconflictedLocalDefnsView
    -> TwoOrThreeWay UnconflictedLocalDefnsView)
-> TwoOrThreeWay UnconflictedLocalDefnsView
forall a b. a -> (a -> b) -> b
& Maybe UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
-> TwoOrThreeWay UnconflictedLocalDefnsView
forall a. Maybe a -> TwoWay a -> TwoOrThreeWay a
Merge.TwoWay.toTwoOrThreeWay Maybe UnconflictedLocalDefnsView
forall a. Maybe a
Nothing
        )
          TwoOrThreeWay UnconflictedLocalDefnsView
-> (UnconflictedLocalDefnsView
    -> Defns
         (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoOrThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \UnconflictedLocalDefnsView
defns ->
            DefnsF Set Name Name
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
forall name terms types.
(Ord name, Ord terms, Ord types) =>
DefnsF Set name name
-> Defns (BiMultimap terms name) (BiMultimap types name)
-> Defns (BiMultimap terms name) (BiMultimap types name)
NamesUtils.restrictNames DefnsF Set Name Name
changedNames UnconflictedLocalDefnsView
defns.defns

  -- Extract out just the builtins, to be rendered specially in the file later
  let changedBuiltinDefns :: Merge.TwoOrThreeWay (DefnsF (Map Name) Text Text)
      changedBuiltinDefns :: TwoOrThreeWay (DefnsF (Map Name) Text Text)
changedBuiltinDefns =
        TwoOrThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
changedDefns
          TwoOrThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> (Defns
      (BiMultimap Referent Name) (BiMultimap TypeReference Name)
    -> DefnsF (Map Name) Text Text)
-> TwoOrThreeWay (DefnsF (Map Name) Text Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (BiMultimap Referent Name -> Map Name Text)
-> (BiMultimap TypeReference Name -> Map Name Text)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF (Map Name) Text Text
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
            ((Referent -> Maybe Text) -> Map Name Referent -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Referent -> Maybe Text
Referent.asBuiltin (Map Name Referent -> Map Name Text)
-> (BiMultimap Referent Name -> Map Name Referent)
-> BiMultimap Referent Name
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)
            ((TypeReference -> Maybe Text)
-> Map Name TypeReference -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Getting (First Text) TypeReference Text
-> TypeReference -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) TypeReference Text
forall t h t' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p t (f t') -> p (Reference' t h) (f (Reference' t' h))
Reference.t_) (Map Name TypeReference -> Map Name Text)
-> (BiMultimap TypeReference Name -> Map Name TypeReference)
-> BiMultimap TypeReference Name
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)

  -- Get the sets of derived reference (to hydrate) referred to by those names on all three branches.
  let defnsToHydrate :: DefnsF Set TermReferenceId TypeReferenceId
      defnsToHydrate :: DefnsF Set TermReferenceId TermReferenceId
defnsToHydrate =
        (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF Set TermReferenceId TermReferenceId)
-> TwoOrThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> DefnsF Set TermReferenceId TermReferenceId
forall m a. Monoid m => (a -> m) -> TwoOrThreeWay a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DefnsF Set Referent TypeReference
-> DefnsF Set TermReferenceId TermReferenceId
NamesUtils.referentsToIds (DefnsF Set Referent TypeReference
 -> DefnsF Set TermReferenceId TermReferenceId)
-> (Defns
      (BiMultimap Referent Name) (BiMultimap TypeReference Name)
    -> DefnsF Set Referent TypeReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF Set TermReferenceId TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF Set Referent TypeReference
forall terms name types.
Defns (BiMultimap terms name) (BiMultimap types name)
-> DefnsF Set terms types
NamesUtils.forgetNames) TwoOrThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
changedDefns

  -- Identify the subsets of those references that we haven't already hydrated, during the process of producing the
  -- diffblob. This may always be the empty set in the current implementation, but doesn't hurt to check.
  let unhydratedDefns :: DefnsF Set TermReferenceId TypeReferenceId
      unhydratedDefns :: DefnsF Set TermReferenceId TermReferenceId
unhydratedDefns =
        (Set TermReferenceId
 -> Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
 -> Set TermReferenceId)
-> (Set TermReferenceId
    -> Map TermReferenceId (Decl Symbol Ann) -> Set TermReferenceId)
-> DefnsF Set TermReferenceId TermReferenceId
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF Set TermReferenceId TermReferenceId
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith
          Set TermReferenceId
-> Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> Set TermReferenceId
forall k a. Ord k => Set k -> Map k a -> Set k
Set.differenceMap
          Set TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Set TermReferenceId
forall k a. Ord k => Set k -> Map k a -> Set k
Set.differenceMap
          DefnsF Set TermReferenceId TermReferenceId
defnsToHydrate
          Diffblob (Branch Transaction)
diffblob.hydratedNarrowedDefns

  -- Hydrate those unhydrated defns
  Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
newlyHydratedDefns <-
    Transaction
  (Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann)))
-> Cli
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall a. Transaction a -> Cli a
Cli.runTransaction do
      Codebase IO Symbol Ann
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term v a, Type v a))
        (Map TermReferenceId (Decl v a)))
UpdateUtils.hydrateRefs Env
env.codebase DefnsF Set TermReferenceId TermReferenceId
unhydratedDefns

  -- Make the full set of hydrated defns
  let hydratedDefns ::
        Defns
          (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
          (Map TypeReferenceId (Decl Symbol Ann))
      hydratedDefns :: Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
        Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
newlyHydratedDefns Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
forall a. Semigroup a => a -> a -> a
<> Diffblob (Branch Transaction)
diffblob.hydratedNarrowedDefns

  Maybe (Text, ExitCode)
maybeDifftoolResult <-
    IO (Maybe String) -> Cli (Maybe String)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
lookupEnv String
"UCM_DIFFTOOL") Cli (Maybe String)
-> (Maybe String -> Cli (Maybe (Text, ExitCode)))
-> Cli (Maybe (Text, ExitCode))
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe String
Nothing -> Maybe (Text, ExitCode) -> Cli (Maybe (Text, ExitCode))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, ExitCode)
forall a. Maybe a
Nothing
      Just String
difftool0 -> do
        -- Make a "libdeps diffs" blob suitable for rendering in files, which merely maps libdep name to its causal
        -- hash. `Nothing` means the libdep was deleted.
        let libdepsDiffs :: Merge.ThreeWay (Map NameSegment (Maybe CausalHash))
            libdepsDiffs :: ThreeWay (Map NameSegment (Maybe CausalHash))
libdepsDiffs =
              Diffblob (Branch Transaction)
diffblob.libdepsDiffs
                TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
-> (TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
    -> TwoWay (Map NameSegment (Maybe CausalHash)))
-> TwoWay (Map NameSegment (Maybe CausalHash))
forall a b. a -> (a -> b) -> b
& (Map NameSegment (DiffOp (Branch Transaction))
 -> Map NameSegment (Maybe CausalHash))
-> TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
-> TwoWay (Map NameSegment (Maybe CausalHash))
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                  ( SimpleWhenMissing NameSegment CausalHash (Maybe CausalHash)
-> SimpleWhenMissing
     NameSegment (DiffOp (Branch Transaction)) (Maybe CausalHash)
-> SimpleWhenMatched
     NameSegment
     CausalHash
     (DiffOp (Branch Transaction))
     (Maybe CausalHash)
-> Map NameSegment CausalHash
-> Map NameSegment (DiffOp (Branch Transaction))
-> Map NameSegment (Maybe CausalHash)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
                      -- If this libdep only exists in the lca, but not alice/bob, that means alice/bob just didn't
                      -- touch it. But the other party did – that's how it exists in the lca blob! So, we still want it
                      -- in both renderings.
                      ((NameSegment -> CausalHash -> Maybe CausalHash)
-> SimpleWhenMissing NameSegment CausalHash (Maybe CausalHash)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \NameSegment
_ -> CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just)
                      -- If this libdep only exists in alice/bob, not lca, it's clearly an add
                      ( (NameSegment -> DiffOp (Branch Transaction) -> Maybe CausalHash)
-> SimpleWhenMissing
     NameSegment (DiffOp (Branch Transaction)) (Maybe CausalHash)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing \NameSegment
_ -> \case
                          Merge.DiffOp'Add Branch Transaction
libdep -> CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just (Branch Transaction -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch Transaction
libdep)
                          -- these are impossible
                          Merge.DiffOp'Update Updated (Branch Transaction)
_ -> String -> Maybe CausalHash
forall a. HasCallStack => String -> a
error String
"expected Add"
                          Merge.DiffOp'Delete Branch Transaction
_ -> String -> Maybe CausalHash
forall a. HasCallStack => String -> a
error String
"expected Add"
                      )
                      -- If this libdep exists in both lca and alice/bob, it's clearly not an add
                      ( (NameSegment
 -> CausalHash -> DiffOp (Branch Transaction) -> Maybe CausalHash)
-> SimpleWhenMatched
     NameSegment
     CausalHash
     (DiffOp (Branch Transaction))
     (Maybe CausalHash)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched \NameSegment
_ CausalHash
_ -> \case
                          Merge.DiffOp'Update Updated (Branch Transaction)
libdeps -> CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just (Branch Transaction -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Updated (Branch Transaction)
libdeps.new)
                          Merge.DiffOp'Delete Branch Transaction
_ -> Maybe CausalHash
forall a. Maybe a
Nothing
                          -- impossible
                          Merge.DiffOp'Add Branch Transaction
_ -> String -> Maybe CausalHash
forall a. HasCallStack => String -> a
error String
"expected Update or Delete"
                      )
                      Map NameSegment CausalHash
lcaLibdepsDiff
                  )
                TwoWay (Map NameSegment (Maybe CausalHash))
-> (TwoWay (Map NameSegment (Maybe CausalHash))
    -> ThreeWay (Map NameSegment (Maybe CausalHash)))
-> ThreeWay (Map NameSegment (Maybe CausalHash))
forall a b. a -> (a -> b) -> b
& Map NameSegment (Maybe CausalHash)
-> TwoWay (Map NameSegment (Maybe CausalHash))
-> ThreeWay (Map NameSegment (Maybe CausalHash))
forall a. a -> TwoWay a -> ThreeWay a
Merge.TwoWay.toThreeWay ((CausalHash -> Maybe CausalHash)
-> Map NameSegment CausalHash -> Map NameSegment (Maybe CausalHash)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just Map NameSegment CausalHash
lcaLibdepsDiff)
              where
                -- The LCA libdeps diff is the causal hashes of every libdep updated or deleted by one party
                lcaLibdepsDiff :: Map NameSegment CausalHash
                lcaLibdepsDiff :: Map NameSegment CausalHash
lcaLibdepsDiff =
                  TwoOrThreeWay (Branch0 Transaction)
namespaces.lca
                    Maybe (Branch0 Transaction)
-> (Maybe (Branch0 Transaction) -> Branch0 Transaction)
-> Branch0 Transaction
forall a b. a -> (a -> b) -> b
& Branch0 Transaction
-> Maybe (Branch0 Transaction) -> Branch0 Transaction
forall a. a -> Maybe a -> a
fromMaybe TwoOrThreeWay (Branch0 Transaction)
namespaces.alice -- a missing LCA means we're treating Alice as LCA
                    Branch0 Transaction
-> (Branch0 Transaction -> Map NameSegment (Branch Transaction))
-> Map NameSegment (Branch Transaction)
forall a b. a -> (a -> b) -> b
& Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
-> Branch0 Transaction -> Map NameSegment (Branch Transaction)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map NameSegment (Branch Transaction))
  (Branch0 Transaction)
  (Map NameSegment (Branch Transaction))
forall (m :: * -> *) (f :: * -> *).
Applicative f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.libdeps_
                    Map NameSegment (Branch Transaction)
-> (Map NameSegment (Branch Transaction)
    -> Map NameSegment (Branch Transaction))
-> Map NameSegment (Branch Transaction)
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch Transaction)
-> Set NameSegment -> Map NameSegment (Branch Transaction)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set NameSegment
deletedAndUpdatedLibdepsNames)
                    Map NameSegment (Branch Transaction)
-> (Map NameSegment (Branch Transaction)
    -> Map NameSegment CausalHash)
-> Map NameSegment CausalHash
forall a b. a -> (a -> b) -> b
& (Branch Transaction -> CausalHash)
-> Map NameSegment (Branch Transaction)
-> Map NameSegment CausalHash
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Branch Transaction -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash

                -- Identify the names of the libdeps that were deleted or updated on alice & bob.
                deletedAndUpdatedLibdepsNames :: Set NameSegment
                deletedAndUpdatedLibdepsNames :: Set NameSegment
deletedAndUpdatedLibdepsNames =
                  (Map NameSegment (DiffOp (Branch Transaction)) -> Set NameSegment)
-> TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
-> Set NameSegment
forall m a. Monoid m => (a -> m) -> TwoWay a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                    ( (NameSegment -> DiffOp (Branch Transaction) -> Set NameSegment)
-> Map NameSegment (DiffOp (Branch Transaction)) -> Set NameSegment
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey \NameSegment
name -> \case
                        Merge.DiffOp'Add Branch Transaction
_ -> Set NameSegment
forall a. Set a
Set.empty
                        Merge.DiffOp'Update Updated (Branch Transaction)
_ -> NameSegment -> Set NameSegment
forall a. a -> Set a
Set.singleton NameSegment
name
                        Merge.DiffOp'Delete Branch Transaction
_ -> NameSegment -> Set NameSegment
forall a. a -> Set a
Set.singleton NameSegment
name
                    )
                    Diffblob (Branch Transaction)
diffblob.libdepsDiffs

        Builder -> Text
makeTempFilename <-
          Cli (Builder -> Text)
forall (m :: * -> *). MonadIO m => m (Builder -> Text)
makeMakeTempFilename

        let filenames :: ThreeWay Text
filenames =
              (Builder -> Text) -> ThreeWay Builder -> ThreeWay Text
forall a b. (a -> b) -> ThreeWay a -> ThreeWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                Builder -> Text
makeTempFilename
                Merge.ThreeWay
                  { $sel:lca:ThreeWay :: Builder
lca = TwoWay Builder
slugs.alice Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TwoWay Builder
slugs.bob Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-merged.u",
                    $sel:alice:ThreeWay :: Builder
alice = TwoWay Builder
slugs.alice Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u",
                    $sel:bob:ThreeWay :: Builder
bob = TwoWay Builder
slugs.bob Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u"
                  }
              where
                slugs :: TwoWay Builder
slugs =
                  DiffBranchArg -> Builder
mangleDiffBranchArg (DiffBranchArg -> Builder)
-> TwoWay DiffBranchArg -> TwoWay Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DiffBranchArg -> TwoWay DiffBranchArg
forall a. TwoWay a -> TwoWay a
maybeSwap TwoWay DiffBranchArg
originalArgs

        let difftool :: Text
difftool =
              String
difftool0
                String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
& String -> 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" ThreeWay Text
filenames.lca
                Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$LOCAL" ThreeWay Text
filenames.alice
                Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$MERGED" ThreeWay Text
filenames.lca
                Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"$REMOTE" ThreeWay Text
filenames.bob

        ExitCode
exitCode <-
          IO ExitCode -> Cli ExitCode
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
            let renderedUnisonFiles :: Merge.ThreeWay Text
                renderedUnisonFiles :: ThreeWay Text
renderedUnisonFiles =
                  Text -> TwoWay Text -> ThreeWay Text
forall a. a -> TwoWay a -> ThreeWay a
Merge.TwoWay.toThreeWay
                    ( -- These either both have a Nothing lca or both have a Just lca
                      case (TwoOrThreeWay (Branch0 Transaction)
namespaces.lca, TwoOrThreeWay (DefnsF (Map Name) Text Text)
changedBuiltinDefns.lca) of
                        (Just Branch0 Transaction
lca, Just DefnsF (Map Name) Text Text
builtins) ->
                          DeclNameLookup
-> Branch0 Transaction
-> Map NameSegment (Maybe CausalHash)
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Text Text
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> Text
forall a v (m :: * -> *).
(Monoid a, Var v) =>
DeclNameLookup
-> Branch0 m
-> Map NameSegment (Maybe CausalHash)
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Text Text
-> Defns
     (Map TermReferenceId (Term v a, Type v a))
     (Map TermReferenceId (Decl v a))
-> Text
renderUnisonFile
                            -- FIXME whoops, we can't always `unsafeParseText` out of a missing name in the LCA here...
                            -- need a rendering function that knows how to print decls with missing names, I guess
                            ((Text -> Name) -> PartialDeclNameLookup -> DeclNameLookup
PartialDeclNameLookup.toDeclNameLookup HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Diffblob (Branch Transaction)
diffblob.declNameLookups.lca)
                            Branch0 Transaction
lca
                            ThreeWay (Map NameSegment (Maybe CausalHash))
libdepsDiffs.lca
                            Diffblob (Branch Transaction)
diffblob.defns.lca
                            DefnsF (Map Name) Text Text
builtins
                            Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns
                        (Maybe (Branch0 Transaction), Maybe (DefnsF (Map Name) Text Text))
_ -> TwoWay Text
aliceAndBobFiles.alice
                    )
                    TwoWay Text
aliceAndBobFiles
                  where
                    aliceAndBobFiles :: Merge.TwoWay Text
                    aliceAndBobFiles :: TwoWay Text
aliceAndBobFiles =
                      DeclNameLookup
-> Branch0 Transaction
-> Map NameSegment (Maybe CausalHash)
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Text Text
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> Text
forall a v (m :: * -> *).
(Monoid a, Var v) =>
DeclNameLookup
-> Branch0 m
-> Map NameSegment (Maybe CausalHash)
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Text Text
-> Defns
     (Map TermReferenceId (Term v a, Type v a))
     (Map TermReferenceId (Decl v a))
-> Text
renderUnisonFile
                        (DeclNameLookup
 -> Branch0 Transaction
 -> Map NameSegment (Maybe CausalHash)
 -> UnconflictedLocalDefnsView
 -> DefnsF (Map Name) Text Text
 -> Defns
      (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
      (Map TermReferenceId (Decl Symbol Ann))
 -> Text)
-> TwoWay DeclNameLookup
-> TwoWay
     (Branch0 Transaction
      -> Map NameSegment (Maybe CausalHash)
      -> UnconflictedLocalDefnsView
      -> DefnsF (Map Name) Text Text
      -> Defns
           (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
           (Map TermReferenceId (Decl Symbol Ann))
      -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
Merge.ThreeWay.gforgetLca Diffblob (Branch Transaction)
diffblob.declNameLookups
                        TwoWay
  (Branch0 Transaction
   -> Map NameSegment (Maybe CausalHash)
   -> UnconflictedLocalDefnsView
   -> DefnsF (Map Name) Text Text
   -> Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
   -> Text)
-> TwoWay (Branch0 Transaction)
-> TwoWay
     (Map NameSegment (Maybe CausalHash)
      -> UnconflictedLocalDefnsView
      -> DefnsF (Map Name) Text Text
      -> Defns
           (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
           (Map TermReferenceId (Decl Symbol Ann))
      -> Text)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoOrThreeWay (Branch0 Transaction) -> TwoWay (Branch0 Transaction)
forall a. TwoOrThreeWay a -> TwoWay a
Merge.TwoOrThreeWay.forgetLca TwoOrThreeWay (Branch0 Transaction)
namespaces
                        TwoWay
  (Map NameSegment (Maybe CausalHash)
   -> UnconflictedLocalDefnsView
   -> DefnsF (Map Name) Text Text
   -> Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
   -> Text)
-> TwoWay (Map NameSegment (Maybe CausalHash))
-> TwoWay
     (UnconflictedLocalDefnsView
      -> DefnsF (Map Name) Text Text
      -> Defns
           (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
           (Map TermReferenceId (Decl Symbol Ann))
      -> Text)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ThreeWay (Map NameSegment (Maybe CausalHash))
-> TwoWay (Map NameSegment (Maybe CausalHash))
forall a. ThreeWay a -> TwoWay a
Merge.ThreeWay.forgetLca ThreeWay (Map NameSegment (Maybe CausalHash))
libdepsDiffs
                        TwoWay
  (UnconflictedLocalDefnsView
   -> DefnsF (Map Name) Text Text
   -> Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
   -> Text)
-> TwoWay UnconflictedLocalDefnsView
-> TwoWay
     (DefnsF (Map Name) Text Text
      -> Defns
           (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
           (Map TermReferenceId (Decl Symbol Ann))
      -> Text)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoWay a
Merge.ThreeWay.forgetLca Diffblob (Branch Transaction)
diffblob.defns
                        TwoWay
  (DefnsF (Map Name) Text Text
   -> Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
   -> Text)
-> TwoWay (DefnsF (Map Name) Text Text)
-> TwoWay
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
      -> Text)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoOrThreeWay (DefnsF (Map Name) Text Text)
-> TwoWay (DefnsF (Map Name) Text Text)
forall a. TwoOrThreeWay a -> TwoWay a
Merge.TwoOrThreeWay.forgetLca TwoOrThreeWay (DefnsF (Map Name) Text Text)
changedBuiltinDefns
                        TwoWay
  (Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
   -> Text)
-> TwoWay
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
-> TwoWay Text
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
-> TwoWay
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall a. a -> TwoWay a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns

            ThreeWay (Text, Text) -> ((Text, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((,) (Text -> Text -> (Text, Text))
-> ThreeWay Text -> ThreeWay (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay Text
filenames ThreeWay (Text -> (Text, Text))
-> ThreeWay Text -> ThreeWay (Text, Text)
forall a b. ThreeWay (a -> b) -> ThreeWay a -> ThreeWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ThreeWay Text
renderedUnisonFiles) \(Text
name, Text
contents) ->
              Env
env.writeSource Text
name Text
contents Bool
True
            let createProcess :: CreateProcess
createProcess = (String -> CreateProcess
Process.shell (Text -> String
Text.unpack Text
difftool)) {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

        Maybe (Text, ExitCode) -> Cli (Maybe (Text, ExitCode))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, ExitCode) -> Maybe (Text, ExitCode)
forall a. a -> Maybe a
Just (Text
difftool, ExitCode
exitCode))

  let typeRefToDeclOrBuiltin :: TypeReference -> DeclOrBuiltin Symbol Ann
      typeRefToDeclOrBuiltin :: TypeReference -> DeclOrBuiltin Symbol Ann
typeRefToDeclOrBuiltin = \case
        Reference.DerivedId TermReferenceId
refId -> Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin (Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types Map TermReferenceId (Decl Symbol Ann)
-> TermReferenceId -> Decl Symbol Ann
forall k a. Ord k => Map k a -> k -> a
Map.! TermReferenceId
refId)
        Reference.Builtin Text
builtin -> ConstructorType -> DeclOrBuiltin Symbol Ann
forall a b. a -> OrBuiltin a b
Builtin (Text -> ConstructorType
Builtin.expectBuiltinConstructorType Text
builtin)

  let termRefToType :: TermReference -> Type Symbol Ann
      termRefToType :: TypeReference -> Type Symbol Ann
termRefToType = \case
        Reference.DerivedId TermReferenceId
refId -> (Term Symbol Ann, Type Symbol Ann) -> Type Symbol Ann
forall a b. (a, b) -> b
snd (Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)
-> TermReferenceId -> (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => Map k a -> k -> a
Map.! TermReferenceId
refId)
        Reference.Builtin Text
builtin -> Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
forall a. BuiltinAnnotation a => a
builtinAnnotation (() -> Ann) -> Term F Symbol () -> Type Symbol Ann
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Term F Symbol ()
Builtin.expectBuiltinTermType Text
builtin

  let newTypes ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (DeclOrBuiltin Symbol Ann)
      newTypes :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
newTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.types Map Name (DiffOp (Synhashed TypeReference))
-> (Map Name (DiffOp (Synhashed TypeReference))
    -> Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed TypeReference)
 -> Maybe (DeclOrBuiltin Symbol Ann))
-> Map Name (DiffOp (Synhashed TypeReference))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Add Synhashed TypeReference
ref -> DeclOrBuiltin Symbol Ann -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> DeclOrBuiltin Symbol Ann
typeRefToDeclOrBuiltin Synhashed TypeReference
ref.value)
          DiffOp (Synhashed TypeReference)
_ -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. Maybe a
Nothing

  let updatedTypes ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (DeclOrBuiltin Symbol Ann)
      updatedTypes :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
updatedTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.types Map Name (DiffOp (Synhashed TypeReference))
-> (Map Name (DiffOp (Synhashed TypeReference))
    -> Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed TypeReference)
 -> Maybe (DeclOrBuiltin Symbol Ann))
-> Map Name (DiffOp (Synhashed TypeReference))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Update Updated (Synhashed TypeReference)
refs -> DeclOrBuiltin Symbol Ann -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> DeclOrBuiltin Symbol Ann
typeRefToDeclOrBuiltin Updated (Synhashed TypeReference)
refs.new.value)
          DiffOp (Synhashed TypeReference)
_ -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. Maybe a
Nothing

  let deletedTypes ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (DeclOrBuiltin Symbol Ann)
      deletedTypes :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
deletedTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.types Map Name (DiffOp (Synhashed TypeReference))
-> (Map Name (DiffOp (Synhashed TypeReference))
    -> Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed TypeReference)
 -> Maybe (DeclOrBuiltin Symbol Ann))
-> Map Name (DiffOp (Synhashed TypeReference))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Delete Synhashed TypeReference
ref -> DeclOrBuiltin Symbol Ann -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> DeclOrBuiltin Symbol Ann
typeRefToDeclOrBuiltin Synhashed TypeReference
ref.value)
          DiffOp (Synhashed TypeReference)
_ -> Maybe (DeclOrBuiltin Symbol Ann)
forall a. Maybe a
Nothing

  let newTerms ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (Type Symbol Ann)
      newTerms :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
newTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.terms Map Name (DiffOp (Synhashed Referent))
-> (Map Name (DiffOp (Synhashed Referent))
    -> Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed Referent) -> Maybe (Type Symbol Ann))
-> Map Name (DiffOp (Synhashed Referent))
-> Map Name (Type Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Add Synhashed Referent
ref | Referent.Ref TypeReference
ref1 <- Synhashed Referent
ref.value -> Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> Type Symbol Ann
termRefToType TypeReference
ref1)
          DiffOp (Synhashed Referent)
_ -> Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing

  let updatedTerms ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (Type Symbol Ann)
      updatedTerms :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
updatedTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.terms Map Name (DiffOp (Synhashed Referent))
-> (Map Name (DiffOp (Synhashed Referent))
    -> Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed Referent) -> Maybe (Type Symbol Ann))
-> Map Name (DiffOp (Synhashed Referent))
-> Map Name (Type Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Update Updated (Synhashed Referent)
refs | Referent.Ref TypeReference
ref1 <- Updated (Synhashed Referent)
refs.new.value -> Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> Type Symbol Ann
termRefToType TypeReference
ref1)
          DiffOp (Synhashed Referent)
_ -> Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing

  let deletedTerms ::
        DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference ->
        Map Name (Type Symbol Ann)
      deletedTerms :: Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
deletedTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns =
        Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
defns.terms Map Name (DiffOp (Synhashed Referent))
-> (Map Name (DiffOp (Synhashed Referent))
    -> Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (DiffOp (Synhashed Referent) -> Maybe (Type Symbol Ann))
-> Map Name (DiffOp (Synhashed Referent))
-> Map Name (Type Symbol Ann)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe \case
          Merge.DiffOp'Delete Synhashed Referent
ref | Referent.Ref TypeReference
ref1 <- Synhashed Referent
ref.value -> Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> Type Symbol Ann
termRefToType TypeReference
ref1)
          DiffOp (Synhashed Referent)
_ -> Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing

  let diffs ::
        Merge.TwoWay
          ( Defns
              ( Map Name (Type Symbol Ann),
                Map Name (Type Symbol Ann),
                Map Name (Type Symbol Ann)
              )
              ( Map Name (DeclOrBuiltin Symbol Ann),
                Map Name (DeclOrBuiltin Symbol Ann),
                Map Name (DeclOrBuiltin Symbol Ann)
              )
          )
      diffs :: TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs =
        Diffblob (Branch Transaction)
diffblob.diffsFromLCA TwoWay
  (Defns
     (Map Name (DiffOp (Synhashed Referent)))
     (Map Name (DiffOp (Synhashed TypeReference))))
-> (Defns
      (Map Name (DiffOp (Synhashed Referent)))
      (Map Name (DiffOp (Synhashed TypeReference)))
    -> Defns
         (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
          Map Name (Type Symbol Ann))
         (Map Name (DeclOrBuiltin Symbol Ann),
          Map Name (DeclOrBuiltin Symbol Ann),
          Map Name (DeclOrBuiltin Symbol Ann)))
-> TwoWay
     (Defns
        (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
         Map Name (Type Symbol Ann))
        (Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff ->
          Defns
            { $sel:terms:Defns :: (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
 Map Name (Type Symbol Ann))
terms = (Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
newTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff, Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
updatedTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff, Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (Type Symbol Ann)
deletedTerms Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff),
              $sel:types:Defns :: (Map Name (DeclOrBuiltin Symbol Ann),
 Map Name (DeclOrBuiltin Symbol Ann),
 Map Name (DeclOrBuiltin Symbol Ann))
types = (Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
newTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff, Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
updatedTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff, Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
-> Map Name (DeclOrBuiltin Symbol Ann)
deletedTypes Defns
  (Map Name (DiffOp (Synhashed Referent)))
  (Map Name (DiffOp (Synhashed TypeReference)))
diff)
            }

  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
    TwoWay DiffBranchArg
-> TwoWay PrettyPrintEnv
-> TwoWay (Map NameSegment (DiffOp CausalHash))
-> TwoWay
     (Defns
        (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
         Map Name (Type Symbol Ann))
        (Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann)))
-> Maybe (Text, ExitCode)
-> Output
Output.ShowBranchDiff
      TwoWay DiffBranchArg
originalArgs
      ((.suffixifiedPPE) (PrettyPrintEnvDecl -> PrettyPrintEnv)
-> (Branch0 Transaction -> PrettyPrintEnvDecl)
-> Branch0 Transaction
-> PrettyPrintEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Branch0 Transaction -> PrettyPrintEnvDecl
forall (m :: * -> *). Int -> Branch0 m -> PrettyPrintEnvDecl
Branch.toPrettyPrintEnvDecl Int
10 (Branch0 Transaction -> PrettyPrintEnv)
-> TwoWay (Branch0 Transaction) -> TwoWay PrettyPrintEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Branch0 Transaction) -> TwoWay (Branch0 Transaction)
forall a. TwoWay a -> TwoWay a
maybeSwap (TwoOrThreeWay (Branch0 Transaction) -> TwoWay (Branch0 Transaction)
forall a. TwoOrThreeWay a -> TwoWay a
Merge.TwoOrThreeWay.forgetLca TwoOrThreeWay (Branch0 Transaction)
namespaces))
      ((DiffOp (Branch Transaction) -> DiffOp CausalHash)
-> Map NameSegment (DiffOp (Branch Transaction))
-> Map NameSegment (DiffOp CausalHash)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Branch Transaction -> CausalHash)
-> DiffOp (Branch Transaction) -> DiffOp CausalHash
forall a b. (a -> b) -> DiffOp a -> DiffOp b
Merge.DiffOp.map Branch Transaction -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash) (Map NameSegment (DiffOp (Branch Transaction))
 -> Map NameSegment (DiffOp CausalHash))
-> TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
-> TwoWay (Map NameSegment (DiffOp CausalHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
-> TwoWay (Map NameSegment (DiffOp (Branch Transaction)))
forall a. TwoWay a -> TwoWay a
maybeSwap Diffblob (Branch Transaction)
diffblob.libdepsDiffs)
      (TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
-> TwoWay
     (Defns
        (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
         Map Name (Type Symbol Ann))
        (Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann),
         Map Name (DeclOrBuiltin Symbol Ann)))
forall a. TwoWay a -> TwoWay a
maybeSwap TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs)
      Maybe (Text, ExitCode)
maybeDifftoolResult

resolveDiffBranchArg ::
  (forall void. Output -> Sqlite.Transaction void) ->
  Sqlite.Project ->
  DiffBranchArg ->
  Sqlite.Transaction CausalHash
resolveDiffBranchArg :: (forall void. Output -> Transaction void)
-> Project -> DiffBranchArg -> Transaction CausalHash
resolveDiffBranchArg forall void. Output -> Transaction void
abort Project
currentProject = \case
  DiffBranchArg'Branch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
names -> do
    ProjectAndBranch Project ProjectBranch
projectAndBranch <-
      (forall void. Output -> Transaction void)
-> Project
-> These ProjectName ProjectBranchName
-> Transaction (ProjectAndBranch Project ProjectBranch)
ProjectUtils.expectProjectAndBranchByTheseNamesTx Output -> Transaction void
forall void. Output -> Transaction void
abort Project
currentProject case ProjectAndBranch (Maybe ProjectName) ProjectBranchName
names.project of
        Maybe ProjectName
Nothing -> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectAndBranch (Maybe ProjectName) ProjectBranchName
names.branch
        Just ProjectName
projectName -> ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projectName ProjectAndBranch (Maybe ProjectName) ProjectBranchName
names.branch
    ProjectBranch -> Transaction CausalHash
ProjectUtils.getProjectBranchCausalHash ProjectAndBranch Project ProjectBranch
projectAndBranch.branch
  DiffBranchArg'Hash ShortCausalHash
hash -> (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
Cli.resolveShortCausalHashToCausalHash Output -> Transaction void
forall void. Output -> Transaction void
abort ShortCausalHash
hash

-- | Mangle a diff branch arg into a text. It's only used to make a somewhat recognizable temp file name.
mangleDiffBranchArg :: DiffBranchArg -> Text.Builder
mangleDiffBranchArg :: DiffBranchArg -> Builder
mangleDiffBranchArg = \case
  DiffBranchArg'Branch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch -> ProjectBranchName -> Builder
projectBranchNameToValidProjectBranchNameText ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch.branch
  DiffBranchArg'Hash ShortCausalHash
hash -> Text -> Builder
Text.Builder.text (ShortCausalHash -> Text
ShortCausalHash.toText ShortCausalHash
hash)

renderUnisonFile ::
  (Monoid a, Var v) =>
  DeclNameLookup ->
  Branch0 m ->
  Map NameSegment (Maybe CausalHash) ->
  UnconflictedLocalDefnsView ->
  DefnsF (Map Name) Text Text ->
  Defns (Map TermReferenceId (Term v a, Type v a)) (Map TypeReferenceId (Decl v a)) ->
  Text
renderUnisonFile :: forall a v (m :: * -> *).
(Monoid a, Var v) =>
DeclNameLookup
-> Branch0 m
-> Map NameSegment (Maybe CausalHash)
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Text Text
-> Defns
     (Map TermReferenceId (Term v a, Type v a))
     (Map TermReferenceId (Decl v a))
-> Text
renderUnisonFile DeclNameLookup
declNameLookup Branch0 m
namespace Map NameSegment (Maybe CausalHash)
libdeps UnconflictedLocalDefnsView
defns DefnsF (Map Name) Text Text
builtinDefns Defns
  (Map TermReferenceId (Term v a, Type v a))
  (Map TermReferenceId (Decl v a))
hydratedDefns =
  let renderedLibdeps :: Pretty ColorText
      renderedLibdeps :: Pretty ColorText
renderedLibdeps =
        Map NameSegment (Maybe CausalHash)
libdeps
          Map NameSegment (Maybe CausalHash)
-> (Map NameSegment (Maybe CausalHash)
    -> [(NameSegment, Maybe CausalHash)])
-> [(NameSegment, Maybe CausalHash)]
forall a b. a -> (a -> b) -> b
& Map NameSegment (Maybe CausalHash)
-> [(NameSegment, Maybe CausalHash)]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(NameSegment, Maybe CausalHash)]
-> ([(NameSegment, Maybe CausalHash)]
    -> [(NameSegment, Maybe CausalHash)])
-> [(NameSegment, Maybe CausalHash)]
forall a b. a -> (a -> b) -> b
& ((NameSegment, Maybe CausalHash) -> NameSegment)
-> [(NameSegment, Maybe CausalHash)]
-> [(NameSegment, Maybe CausalHash)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (NameSegment, Maybe CausalHash) -> NameSegment
forall a b. (a, b) -> a
fst
          [(NameSegment, Maybe CausalHash)]
-> ([(NameSegment, Maybe CausalHash)] -> [Pretty ColorText])
-> [Pretty ColorText]
forall a b. a -> (a -> b) -> b
& ((NameSegment, Maybe CausalHash) -> Pretty ColorText)
-> [(NameSegment, Maybe CausalHash)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \case
                (NameSegment
libdep, Maybe CausalHash
Nothing) -> Pretty ColorText
"-- lib." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Pretty ColorText
prettyLibdepName NameSegment
libdep Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" ="
                (NameSegment
libdep, Just CausalHash
hash) -> Pretty ColorText
"-- lib." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Pretty ColorText
prettyLibdepName NameSegment
libdep Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" = " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> CausalHash -> Pretty ColorText
forall s. IsString s => CausalHash -> Pretty s
prettyCausalHash CausalHash
hash
            )
          [Pretty ColorText]
-> ([Pretty ColorText] -> Pretty ColorText) -> Pretty ColorText
forall a b. a -> (a -> b) -> b
& [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pretty.lines

      builtinDefns1 :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
      builtinDefns1 :: Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
builtinDefns1 =
        let f :: Map Name Text -> Map Name (Pretty ColorText)
f =
              (Name -> Text -> Pretty ColorText)
-> Map Name Text -> Map Name (Pretty ColorText)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
                ( \Name
name Text
builtin ->
                    Pretty ColorText
"-- "
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty ColorText
forall s. IsString s => Name -> Pretty s
NamePrinter.prettyName Name
name
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" refers to builtin ##"
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text Text
builtin
                )
         in (Map Name Text -> Map Name (Pretty ColorText))
-> (Map Name Text -> Map Name (Pretty ColorText))
-> DefnsF (Map Name) Text Text
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
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 Text -> Map Name (Pretty ColorText)
f Map Name Text -> Map Name (Pretty ColorText)
f DefnsF (Map Name) Text Text
builtinDefns

      nonBuiltinDefns :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
      nonBuiltinDefns :: Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
nonBuiltinDefns =
        DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
forall a v.
(Var v, Monoid a) =>
DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
FilePrinter.renderDefnsForUnisonFile
          DeclNameLookup
declNameLookup
          (Int -> Branch0 m -> PrettyPrintEnvDecl
forall (m :: * -> *). Int -> Branch0 m -> PrettyPrintEnvDecl
Branch.toPrettyPrintEnvDecl Int
10 Branch0 m
namespace)
          Set Name
forall a. Set a
Set.empty
          ( Defns
  (Map TermReferenceId (Term v a, Type v a))
  (Map TermReferenceId (Decl v a))
hydratedDefns
              Defns
  (Map TermReferenceId (Term v a, Type v a))
  (Map TermReferenceId (Decl v a))
-> (Defns
      (Map TermReferenceId (Term v a, Type v a))
      (Map TermReferenceId (Decl v a))
    -> DefnsF
         (Map Name)
         (TermReferenceId, (Term v a, Type v a))
         (TermReferenceId, Decl v a))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term v a, Type v a))
     (TermReferenceId, Decl v a)
forall a b. a -> (a -> b) -> b
& Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns
     (Map TermReferenceId (Term v a, Type v a))
     (Map TermReferenceId (Decl v a))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term v a, Type v a))
     (TermReferenceId, Decl v a)
forall name term typ.
Ord name =>
Defns (BiMultimap Referent name) (BiMultimap TypeReference name)
-> Defns (Map TermReferenceId term) (Map TermReferenceId typ)
-> DefnsF (Map name) (TermReferenceId, term) (TermReferenceId, typ)
UpdateUtils.nameHydratedRefIds2 UnconflictedLocalDefnsView
defns.defns
              DefnsF
  (Map Name)
  (TermReferenceId, (Term v a, Type v a))
  (TermReferenceId, Decl v a)
-> (DefnsF
      (Map Name)
      (TermReferenceId, (Term v a, Type v a))
      (TermReferenceId, Decl v a)
    -> DefnsF
         (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a))
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term v a, Type v a))
     (TermReferenceId, Decl v a))
  (DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a))
  (TermReferenceId, (Term v a, Type v a))
  (Term v a, Type v a)
-> ((TermReferenceId, (Term v a, Type v a))
    -> (Term v a, Type v a))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term v a, Type v a))
     (TermReferenceId, Decl v a)
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Name (TermReferenceId, (Term v a, Type v a))
 -> Identity (Map Name (Term v a, Type v a)))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term v a, Type v a))
     (TermReferenceId, Decl v a)
-> Identity
     (DefnsF
        (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a))
#terms ((Map Name (TermReferenceId, (Term v a, Type v a))
  -> Identity (Map Name (Term v a, Type v a)))
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term v a, Type v a))
      (TermReferenceId, Decl v a)
 -> Identity
      (DefnsF
         (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)))
-> (((TermReferenceId, (Term v a, Type v a))
     -> Identity (Term v a, Type v a))
    -> Map Name (TermReferenceId, (Term v a, Type v a))
    -> Identity (Map Name (Term v a, Type v a)))
-> ASetter
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term v a, Type v a))
        (TermReferenceId, Decl v a))
     (DefnsF
        (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a))
     (TermReferenceId, (Term v a, Type v a))
     (Term v a, Type v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReferenceId, (Term v a, Type v a))
 -> Identity (Term v a, Type v a))
-> Map Name (TermReferenceId, (Term v a, Type v a))
-> Identity (Map Name (Term v a, Type v a))
Setter
  (Map Name (TermReferenceId, (Term v a, Type v a)))
  (Map Name (Term v a, Type v a))
  (TermReferenceId, (Term v a, Type v a))
  (Term v a, Type v a)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (TermReferenceId, (Term v a, Type v a)) -> (Term v a, Type v a)
forall a b. (a, b) -> b
snd
          )

      renderedDefns :: Pretty ColorText
      renderedDefns :: Pretty ColorText
renderedDefns =
        (Map Name (Pretty ColorText)
 -> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText))
-> (Map Name (Pretty ColorText)
    -> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText))
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
-> Defns
     (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Map Name (Pretty ColorText)
-> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name (Pretty ColorText)
-> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
builtinDefns1 Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
nonBuiltinDefns
          Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
-> (Defns
      (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
    -> [(Name, Pretty ColorText)])
-> [(Name, Pretty ColorText)]
forall a b. a -> (a -> b) -> b
& (\Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
defns -> Map Name (Pretty ColorText) -> [(Name, Pretty ColorText)]
forall k a. Map k a -> [(k, a)]
Map.toList Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
defns.terms [(Name, Pretty ColorText)]
-> [(Name, Pretty ColorText)] -> [(Name, Pretty ColorText)]
forall a. [a] -> [a] -> [a]
++ Map Name (Pretty ColorText) -> [(Name, Pretty ColorText)]
forall k a. Map k a -> [(k, a)]
Map.toList Defns (Map Name (Pretty ColorText)) (Map Name (Pretty ColorText))
defns.types)
          [(Name, Pretty ColorText)]
-> ([(Name, Pretty ColorText)] -> [(Name, Pretty ColorText)])
-> [(Name, Pretty ColorText)]
forall a b. a -> (a -> b) -> b
& ((Name, Pretty ColorText) -> Name)
-> [(Name, Pretty ColorText)] -> [(Name, Pretty ColorText)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Name, Pretty ColorText) -> Name
forall a b. (a, b) -> a
fst
          [(Name, Pretty ColorText)]
-> ([(Name, Pretty ColorText)] -> Pretty ColorText)
-> Pretty ColorText
forall a b. a -> (a -> b) -> b
& ((Name, Pretty ColorText) -> Pretty ColorText)
-> [(Name, Pretty ColorText)] -> Pretty ColorText
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Name
_, Pretty ColorText
defn) -> Pretty ColorText
defn Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline)
   in Width -> Pretty ColorText -> Text
Pretty.toPlain Width
80 (Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pretty.sepNonEmpty Pretty ColorText
"\n\n" [Pretty ColorText
renderedLibdeps, Pretty ColorText
renderedDefns])