module Unison.Merge.Mergeblob
  ( Mergeblob (..),
    MergeblobError (..),
    makeMergeblob,
  )
where

import Control.Monad.Trans.Except qualified as Except
import Data.Bifoldable (bifold, bifoldMap)
import Data.Bitraversable (bitraverse)
import Data.List qualified as List
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.DeclNameLookup qualified as DeclNameLookup
import Unison.FileParsers qualified as FileParsers
import Unison.Merge.Diffblob (Diffblob (..))
import Unison.Merge.EitherWay (EitherWay (..))
import Unison.Merge.EitherWay qualified as EitherWay
import Unison.Merge.FindConflictedAlias (findConflictedAlias)
import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins)
import Unison.Merge.Render (renderUnisonFiles)
import Unison.Merge.ThreeWay (ThreeWay)
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.TwoWay qualified as TwoWay
import Unison.Merge.Unconflicts (Unconflicts (..))
import Unison.Merge.Unconflicts qualified as Unconflicts
import Unison.Merge.Updated (GUpdated (..), Updated)
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parsers qualified as Parsers
import Unison.Prelude
import Unison.Reference (Reference, Reference' (..), TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Symbol (Symbol)
import Unison.Syntax.Parser (ParsingEnv (..))
import Unison.Syntax.Parser qualified as Parser
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Typechecker qualified as Typechecker
import Unison.Typechecker.TypeLookup (TypeLookup)
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UnisonFile
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defn (Defn)
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith, zipDefnsWith3, zipDefnsWith4)
import Unison.Util.Map qualified as Map
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set

data Mergeblob libdep = Mergeblob
  { forall libdep.
Mergeblob libdep
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId),
    forall libdep.
Mergeblob libdep -> Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile :: Maybe (TypecheckedUnisonFile Symbol Ann),
    forall libdep.
Mergeblob libdep -> DefnsF (Map Name) Referent TermReference
unconflictedDefns :: DefnsF (Map Name) Referent TypeReference,
    forall libdep. Mergeblob libdep -> TwoWay (Map Name Text)
uniqueTypeGuids :: TwoWay (Map Name Text),
    -- `unparsedFile` (no mergetool) xor `unparsedSoloFiles` (yes mergetool) are ultimately given to the user
    forall libdep. Mergeblob libdep -> Pretty ColorText
unparsedFile :: Pretty ColorText,
    forall libdep. Mergeblob libdep -> ThreeWay (Pretty ColorText)
unparsedSoloFiles :: ThreeWay (Pretty ColorText)
  }

data MergeblobError
  = MergeblobError'ConflictedAlias (EitherWay (Defn (Name, Name) (Name, Name)))
  | MergeblobError'ConflictedBuiltin (Defn Name Name)

makeMergeblob ::
  (Monad m) =>
  ( ThreeWay (DefnsF Set TermReferenceId TypeReferenceId) ->
    m (Defns (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)))
  ) ->
  (DefnsF Set TermReferenceId TypeReferenceId -> Set Reference -> m (DefnsF Set TermReferenceId TypeReferenceId)) ->
  m (Updated Names) ->
  (DefnsF Set TermReference TypeReference -> m (TypeLookup Symbol Ann)) ->
  Diffblob libdep ->
  TwoWay Text ->
  m (Either MergeblobError (Mergeblob libdep))
makeMergeblob :: forall (m :: * -> *) libdep.
Monad m =>
(ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
 -> m (Defns
         (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
         (Map TermReferenceId (Decl Symbol Ann))))
-> (DefnsF Set TermReferenceId TermReferenceId
    -> Set TermReference
    -> m (DefnsF Set TermReferenceId TermReferenceId))
-> m (Updated Names)
-> (DefnsF Set TermReference TermReference
    -> m (TypeLookup Symbol Ann))
-> Diffblob libdep
-> TwoWay Text
-> m (Either MergeblobError (Mergeblob libdep))
makeMergeblob ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate DefnsF Set TermReferenceId TermReferenceId
-> Set TermReference
-> m (DefnsF Set TermReferenceId TermReferenceId)
loadDependents m (Updated Names)
loadLibdepsNames DefnsF Set TermReference TermReference -> m (TypeLookup Symbol Ann)
loadTypeLookup Diffblob libdep
blob TwoWay Text
authors = ExceptT MergeblobError m (Mergeblob libdep)
-> m (Either MergeblobError (Mergeblob libdep))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT do
  -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias
  Maybe (Defn (Name, Name) (Name, Name))
-> (Defn (Name, Name) (Name, Name) -> ExceptT MergeblobError m ())
-> ExceptT MergeblobError m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> Maybe (Defn (Name, Name) (Name, Name))
forall name (synhashed :: * -> *) term typ.
(Ord name, forall ref. Eq (synhashed ref), Ord term, Ord typ) =>
Defns (BiMultimap term name) (BiMultimap typ name)
-> DefnsF3 (Map name) DiffOp synhashed term typ
-> Maybe (Defn (name, name) (name, name))
findConflictedAlias Diffblob libdep
blob.defns.lca.defns Diffblob libdep
blob.diffsFromLCA.alice) \Defn (Name, Name) (Name, Name)
conflict ->
    MergeblobError -> ExceptT MergeblobError m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (EitherWay (Defn (Name, Name) (Name, Name)) -> MergeblobError
MergeblobError'ConflictedAlias (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
forall a. a -> EitherWay a
Alice Defn (Name, Name) (Name, Name)
conflict))
  Maybe (Defn (Name, Name) (Name, Name))
-> (Defn (Name, Name) (Name, Name) -> ExceptT MergeblobError m ())
-> ExceptT MergeblobError m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> Maybe (Defn (Name, Name) (Name, Name))
forall name (synhashed :: * -> *) term typ.
(Ord name, forall ref. Eq (synhashed ref), Ord term, Ord typ) =>
Defns (BiMultimap term name) (BiMultimap typ name)
-> DefnsF3 (Map name) DiffOp synhashed term typ
-> Maybe (Defn (name, name) (name, name))
findConflictedAlias Diffblob libdep
blob.defns.lca.defns Diffblob libdep
blob.diffsFromLCA.bob) \Defn (Name, Name) (Name, Name)
conflict ->
    MergeblobError -> ExceptT MergeblobError m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (EitherWay (Defn (Name, Name) (Name, Name)) -> MergeblobError
MergeblobError'ConflictedAlias (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
forall a. a -> EitherWay a
Bob Defn (Name, Name) (Name, Name)
conflict))

  TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts <-
    Either
  (Defn Name Name)
  (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> ExceptT
     (Defn Name Name)
     m
     (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
Except.except (TwoWay (DefnsF (Map Name) TermReference TermReference)
-> Either
     (Defn Name Name)
     (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
narrowConflictsToNonBuiltins Diffblob libdep
blob.conflicts)
      ExceptT
  (Defn Name Name)
  m
  (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> (ExceptT
      (Defn Name Name)
      m
      (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
    -> ExceptT
         MergeblobError
         m
         (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)))
-> ExceptT
     MergeblobError
     m
     (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
forall a b. a -> (a -> b) -> b
& (Defn Name Name -> MergeblobError)
-> ExceptT
     (Defn Name Name)
     m
     (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> ExceptT
     MergeblobError
     m
     (TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
Except.withExceptT Defn Name Name -> MergeblobError
MergeblobError'ConflictedBuiltin

  m (Mergeblob libdep) -> ExceptT MergeblobError m (Mergeblob libdep)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT MergeblobError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    let conflictsNames :: TwoWay (DefnsF Set Name Name)
        conflictsNames :: TwoWay (DefnsF Set Name Name)
conflictsNames =
          (Map Name TermReferenceId -> Set Name)
-> (Map Name TermReferenceId -> Set Name)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> 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 TermReferenceId -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name TermReferenceId -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (DefnsF (Map Name) TermReferenceId TermReferenceId
 -> DefnsF Set Name Name)
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts

    let coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference)
        coreDependencies :: TwoWay (DefnsF Set TermReference TermReference)
coreDependencies =
          TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set TermReference TermReference)
identifyCoreDependencies
            ((.defns) (UnconflictedLocalDefnsView
 -> Defns
      (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay UnconflictedLocalDefnsView
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Diffblob libdep
blob.defns)
            ((Map Name TermReferenceId -> Set TermReferenceId)
-> (Map Name TermReferenceId -> Set TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF Set 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 ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) (DefnsF (Map Name) TermReferenceId TermReferenceId
 -> DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts)
            Diffblob libdep
blob.unconflicts

    TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependentsIds <- do
      TwoWay
  (DefnsF Set TermReferenceId TermReferenceId,
   DefnsF Set TermReference TermReference)
-> ((DefnsF Set TermReferenceId TermReferenceId,
     DefnsF Set TermReference TermReference)
    -> m (DefnsF Set TermReferenceId TermReferenceId))
-> m (TwoWay (DefnsF Set TermReferenceId TermReferenceId))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ((,) (DefnsF Set TermReferenceId TermReferenceId
 -> DefnsF Set TermReference TermReference
 -> (DefnsF Set TermReferenceId TermReferenceId,
     DefnsF Set TermReference TermReference))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay
     (DefnsF Set TermReference TermReference
      -> (DefnsF Set TermReferenceId TermReferenceId,
          DefnsF Set TermReference TermReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Diffblob libdep
blob.defnsIds TwoWay
  (DefnsF Set TermReference TermReference
   -> (DefnsF Set TermReferenceId TermReferenceId,
       DefnsF Set TermReference TermReference))
-> TwoWay (DefnsF Set TermReference TermReference)
-> TwoWay
     (DefnsF Set TermReferenceId TermReferenceId,
      DefnsF Set TermReference TermReference)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF Set TermReference TermReference)
coreDependencies) \(DefnsF Set TermReferenceId TermReferenceId
defns, DefnsF Set TermReference TermReference
deps) ->
        DefnsF Set TermReferenceId TermReferenceId
-> Set TermReference
-> m (DefnsF Set TermReferenceId TermReferenceId)
loadDependents DefnsF Set TermReferenceId TermReferenceId
defns (DefnsF Set TermReference TermReference -> Set TermReference
forall m. Monoid m => Defns m m -> m
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold DefnsF Set TermReference TermReference
deps)

    Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefnsById <- do
      let unhydratedConflictsAndDependentsIds :: TwoWay (DefnsF Set TermReferenceId TypeReferenceId)
          unhydratedConflictsAndDependentsIds :: TwoWay (DefnsF Set TermReferenceId TermReferenceId)
unhydratedConflictsAndDependentsIds =
            (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
 -> Defns
      (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
      (Map TermReferenceId (Decl Symbol Ann))
 -> DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann))
      -> DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Map Name TermReferenceId -> Set TermReferenceId)
-> (Map Name TermReferenceId -> Set TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF Set 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 Map Name TermReferenceId -> Set TermReferenceId
forall v k. Ord v => Map k v -> Set v
Map.elemsSet Map Name TermReferenceId -> Set TermReferenceId
forall v k. Ord v => Map k v -> Set v
Map.elemsSet (DefnsF (Map Name) TermReferenceId TermReferenceId
 -> DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts) TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
forall a. Semigroup a => a -> a -> a
<> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependentsIds)
              TwoWay
  (Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
   -> DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
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
TwoWay.bothWays Diffblob libdep
blob.hydratedNarrowedDefns

      Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedConflictsAndDependents <-
        ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
-> m (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
hydrate (DefnsF Set TermReferenceId TermReferenceId
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> ThreeWay (DefnsF Set TermReferenceId TermReferenceId)
forall a. a -> TwoWay a -> ThreeWay a
TwoWay.toThreeWay (Set TermReferenceId
-> Set TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId
forall terms types. terms -> types -> Defns terms types
Defns Set TermReferenceId
forall a. Set a
Set.empty Set TermReferenceId
forall a. Set a
Set.empty) TwoWay (DefnsF Set TermReferenceId TermReferenceId)
unhydratedConflictsAndDependentsIds)

      -- Left-biased map union is ok here since the maps are disjoint
      pure (Diffblob libdep
blob.hydratedNarrowedDefns 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
<> Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedConflictsAndDependents)

    let hydratedDefnsByName ::
          ThreeWay
            ( DefnsF
                (Map Name)
                (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
                (TypeReferenceId, Decl Symbol Ann)
            )
        hydratedDefnsByName :: ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefnsByName =
          Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF (Map Name) Referent TermReference
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
forall term typ name.
Defns (Map TermReferenceId term) (Map TermReferenceId typ)
-> DefnsF (Map name) Referent TermReference
-> DefnsF (Map name) (TermReferenceId, term) (TermReferenceId, typ)
nameHydratedRefs Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefnsById (DefnsF (Map Name) Referent TermReference
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann))
-> (UnconflictedLocalDefnsView
    -> DefnsF (Map Name) Referent TermReference)
-> UnconflictedLocalDefnsView
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TermReference Name -> Map Name TermReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF (Map Name) Referent TermReference
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 Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap TermReference Name -> Map Name TermReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
 -> DefnsF (Map Name) Referent TermReference)
-> (UnconflictedLocalDefnsView
    -> Defns
         (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Referent TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.defns) (UnconflictedLocalDefnsView
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann))
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diffblob libdep
blob.defns

    let dependentsNames :: TwoWay (DefnsF Set Name Name)
        dependentsNames :: TwoWay (DefnsF Set Name Name)
dependentsNames =
          let -- Compute the set of dependents names
              allDependentsNames :: TwoWay (DefnsF Set Name Name)
              allDependentsNames :: TwoWay (DefnsF Set Name Name)
allDependentsNames =
                (BiMultimap Referent Name -> Set TermReferenceId -> Set Name)
-> (BiMultimap TermReference Name
    -> Set TermReferenceId -> Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF Set TermReferenceId TermReferenceId
-> DefnsF Set Name Name
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith
                  (\BiMultimap Referent Name
defns Set TermReferenceId
deps -> (Referent -> NESet Name -> Set Name)
-> Map Referent (NESet Name) -> Set Name
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (Set TermReferenceId -> Referent -> NESet Name -> Set Name
f Set TermReferenceId
deps) (BiMultimap Referent Name -> Map Referent (NESet Name)
forall a b. BiMultimap a b -> Map a (NESet b)
BiMultimap.domain BiMultimap Referent Name
defns))
                  (\BiMultimap TermReference Name
defns Set TermReferenceId
deps -> (TermReference -> NESet Name -> Set Name)
-> Map TermReference (NESet Name) -> Set Name
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (Set TermReferenceId -> TermReference -> NESet Name -> Set Name
g Set TermReferenceId
deps) (BiMultimap TermReference Name -> Map TermReference (NESet Name)
forall a b. BiMultimap a b -> Map a (NESet b)
BiMultimap.domain BiMultimap TermReference Name
defns))
                  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
 -> DefnsF Set TermReferenceId TermReferenceId
 -> DefnsF Set Name Name)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
     (DefnsF Set TermReferenceId TermReferenceId
      -> DefnsF Set Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((.defns) (UnconflictedLocalDefnsView
 -> Defns
      (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay UnconflictedLocalDefnsView
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay UnconflictedLocalDefnsView
-> TwoWay UnconflictedLocalDefnsView
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Diffblob libdep
blob.defns)
                  TwoWay
  (DefnsF Set TermReferenceId TermReferenceId
   -> DefnsF Set Name Name)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set Name Name)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependentsIds
                where
                  f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name
                  f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name
f Set TermReferenceId
deps Referent
defn0 NESet Name
names
                    | Just TermReferenceId
defn <- Referent -> Maybe TermReferenceId
Referent.toTermReferenceId Referent
defn0,
                      TermReferenceId -> Set TermReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TermReferenceId
defn Set TermReferenceId
deps =
                        NESet Name -> Set Name
forall a. NESet a -> Set a
Set.NonEmpty.toSet NESet Name
names
                    | Bool
otherwise = Set Name
forall a. Set a
Set.empty
                  g :: Set TypeReferenceId -> TypeReference -> NESet Name -> Set Name
                  g :: Set TermReferenceId -> TermReference -> NESet Name -> Set Name
g Set TermReferenceId
deps TermReference
defn0 NESet Name
names
                    | ReferenceDerived TermReferenceId
defn <- TermReference
defn0,
                      TermReferenceId -> Set TermReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TermReferenceId
defn Set TermReferenceId
deps =
                        NESet Name -> Set Name
forall a. NESet a -> Set a
Set.NonEmpty.toSet NESet Name
names
                    | Bool
otherwise = Set Name
forall a. Set a
Set.empty
           in -- Filter it down by identifying the unconflicted dependents we need to pull into the Unison file (either
              -- first for typechecking, if there aren't conflicts, or else for manual conflict resolution without a
              -- typechecking step, if there are)
              TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
forall term typ.
TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts typ term
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
mergeDependents TwoWay (DefnsF Set Name Name)
conflictsNames Diffblob libdep
blob.unconflicts TwoWay (DefnsF Set Name Name)
allDependentsNames

    Updated Names
libdepsNames <- m (Updated Names)
loadLibdepsNames

    let (Pretty ColorText
unparsedFile, ThreeWay (Pretty ColorText)
unparsedSoloFiles) =
          TwoWay Text
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> ThreeWay (DefnsF (Map Name) Referent TermReference)
-> ThreeWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> Updated Names
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
-> (Pretty ColorText, ThreeWay (Pretty ColorText))
renderUnisonFiles
            TwoWay Text
authors
            Diffblob libdep
blob.declNameLookups
            ((BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TermReference Name -> Map Name TermReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF (Map Name) Referent TermReference
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 Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap TermReference Name -> Map Name TermReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
 -> DefnsF (Map Name) Referent TermReference)
-> (UnconflictedLocalDefnsView
    -> Defns
         (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> UnconflictedLocalDefnsView
-> DefnsF (Map Name) Referent TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.defns) (UnconflictedLocalDefnsView
 -> DefnsF (Map Name) Referent TermReference)
-> ThreeWay UnconflictedLocalDefnsView
-> ThreeWay (DefnsF (Map Name) Referent TermReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diffblob libdep
blob.defns)
            ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefnsByName
            Updated Names
libdepsNames
            TwoWay (DefnsF Set Name Name)
conflictsNames
            TwoWay (DefnsF Set Name Name)
dependentsNames

    Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile <-
      if DefnsF (Map Name) TermReferenceId TermReferenceId -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.alice
        then
          let uniqueTypeGuids :: TwoWay (Map Name Text)
uniqueTypeGuids =
                ((TermReferenceId, Decl Symbol Ann) -> Maybe Text)
-> Map Name (TermReferenceId, Decl Symbol Ann) -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Decl Symbol Ann -> Maybe Text
forall v a. Decl v a -> Maybe Text
DataDeclaration.uniqueTypeGuid (Decl Symbol Ann -> Maybe Text)
-> ((TermReferenceId, Decl Symbol Ann) -> Decl Symbol Ann)
-> (TermReferenceId, Decl Symbol Ann)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermReferenceId, Decl Symbol Ann) -> Decl Symbol Ann
forall a b. (a, b) -> b
snd) (Map Name (TermReferenceId, Decl Symbol Ann) -> Map Name Text)
-> (DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
    -> Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.types)
                  (DefnsF
   (Map Name)
   (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
   (TermReferenceId, Decl Symbol Ann)
 -> Map Name Text)
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Map Name Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefnsByName

              unconflictedDefns :: DefnsF (Map Name) Referent TermReference
unconflictedDefns =
                TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) Referent TermReference
-> DefnsF (Map Name) Referent TermReference
forall term typ.
TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts term typ
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeUnconflictedDefns
                  (GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
ThreeWay.gforgetLca Diffblob libdep
blob.declNameLookups)
                  TwoWay (DefnsF Set Name Name)
conflictsNames
                  Diffblob libdep
blob.unconflicts
                  TwoWay (DefnsF Set Name Name)
dependentsNames
                  ((BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TermReference Name -> Map Name TermReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF (Map Name) Referent TermReference
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 Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap TermReference Name -> Map Name TermReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range Diffblob libdep
blob.defns.lca.defns)

              parsingEnv :: ParsingEnv Identity
parsingEnv =
                ParsingEnv
                  { -- We don't expect to have to generate any new GUIDs, since the uniqueTypeGuid lookup function below should
                    -- cover all name in the merged file we're about to parse and typecheck. So, this might be more correct as a
                    -- call to `error`.
                    $sel:uniqueNames:ParsingEnv :: UniqueName
uniqueNames = (Pos -> Int -> Maybe Text) -> UniqueName
Parser.UniqueName \Pos
_ Int
_ -> Maybe Text
forall a. Maybe a
Nothing,
                    $sel:uniqueTypeGuid:ParsingEnv :: Name -> Identity (Maybe Text)
uniqueTypeGuid =
                      let -- Prefer Alice's GUID if they both have one.
                          guids :: Map Name Text
                          guids :: Map Name Text
guids =
                            SimpleWhenMissing Name Text Text
-> SimpleWhenMissing Name Text Text
-> SimpleWhenMatched Name Text Text Text
-> Map Name Text
-> Map Name Text
-> Map Name Text
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
                              SimpleWhenMissing Name Text Text
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
                              SimpleWhenMissing Name Text Text
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
                              ((Name -> Text -> Text -> Text)
-> SimpleWhenMatched Name Text Text Text
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched \Name
_ Text
aliceGuid Text
_ -> Text
aliceGuid)
                              TwoWay (Map Name Text)
uniqueTypeGuids.alice
                              TwoWay (Map Name Text)
uniqueTypeGuids.bob
                       in \Name
name -> Maybe Text -> Identity (Maybe Text)
forall a. a -> Identity a
Identity (Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name Text
guids),
                    $sel:names:ParsingEnv :: Names
names = DefnsF (Map Name) Referent TermReference -> Names
Names.fromUnconflicted DefnsF (Map Name) Referent TermReference
unconflictedDefns Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Updated Names
libdepsNames.new,
                    $sel:maybeNamespace:ParsingEnv :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
                    $sel:localNamespacePrefixedTypesAndConstructors:ParsingEnv :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
                  }
           in case Identity (Either (Err Symbol) (UnisonFile Symbol Ann))
-> Either (Err Symbol) (UnisonFile Symbol Ann)
forall a. Identity a -> a
runIdentity (FilePath
-> FilePath
-> ParsingEnv Identity
-> Identity (Either (Err Symbol) (UnisonFile Symbol Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
FilePath
-> FilePath
-> ParsingEnv m
-> m (Either (Err v) (UnisonFile v Ann))
Parsers.parseFile FilePath
"<merge>" (Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Pretty ColorText
unparsedFile) ParsingEnv Identity
parsingEnv) of
                Left Err Symbol
_err -> Maybe (TypecheckedUnisonFile Symbol Ann)
-> m (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing
                Right UnisonFile Symbol Ann
file -> do
                  TypeLookup Symbol Ann
typeLookup <- DefnsF Set TermReference TermReference -> m (TypeLookup Symbol Ann)
loadTypeLookup (UnisonFile Symbol Ann -> DefnsF Set TermReference TermReference
forall a v.
(Monoid a, Var v) =>
UnisonFile v a -> DefnsF Set TermReference TermReference
UnisonFile.dependencies UnisonFile Symbol Ann
file)
                  let typecheckingEnv :: Env Symbol Ann
typecheckingEnv =
                        Typechecker.Env
                          { $sel:ambientAbilities:Env :: [Type Symbol Ann]
ambientAbilities = [],
                            $sel:termsByShortname:Env :: Map Name [Either Name (NamedReference Symbol Ann)]
termsByShortname = Map Name [Either Name (NamedReference Symbol Ann)]
forall k a. Map k a
Map.empty,
                            TypeLookup Symbol Ann
typeLookup :: TypeLookup Symbol Ann
$sel:typeLookup:Env :: TypeLookup Symbol Ann
typeLookup,
                            $sel:freeNameToFuzzyTermsByShortName:Env :: Map Name (Map Name [Either Name (NamedReference Symbol Ann)])
freeNameToFuzzyTermsByShortName = Map Name (Map Name [Either Name (NamedReference Symbol Ann)])
forall k a. Map k a
Map.empty,
                            $sel:topLevelComponents:Env :: Map Name (NamedReference Symbol Ann)
topLevelComponents = Map Name (NamedReference Symbol Ann)
forall k a. Map k a
Map.empty
                          }
                  Env Symbol Ann
-> UnisonFile Symbol Ann
-> ResultT
     (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
FileParsers.synthesizeFile Env Symbol Ann
typecheckingEnv UnisonFile Symbol Ann
file
                    ResultT
  (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
-> (ResultT
      (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
    -> Identity
         (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann)))
-> Identity
     (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
forall a b. a -> (a -> b) -> b
& ResultT
  (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
-> Identity
     (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
Result.runResultT
                    Identity
  (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
-> (Identity
      (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
    -> (Maybe (TypecheckedUnisonFile Symbol Ann),
        Seq (Note Symbol Ann)))
-> (Maybe (TypecheckedUnisonFile Symbol Ann),
    Seq (Note Symbol Ann))
forall a b. a -> (a -> b) -> b
& Identity
  (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
-> (Maybe (TypecheckedUnisonFile Symbol Ann),
    Seq (Note Symbol Ann))
forall a. Identity a -> a
runIdentity
                    (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
-> ((Maybe (TypecheckedUnisonFile Symbol Ann),
     Seq (Note Symbol Ann))
    -> Maybe (TypecheckedUnisonFile Symbol Ann))
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Maybe (TypecheckedUnisonFile Symbol Ann), Seq (Note Symbol Ann))
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall a b. (a, b) -> a
fst
                    Maybe (TypecheckedUnisonFile Symbol Ann)
-> (Maybe (TypecheckedUnisonFile Symbol Ann)
    -> m (Maybe (TypecheckedUnisonFile Symbol Ann)))
-> m (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a b. a -> (a -> b) -> b
& Maybe (TypecheckedUnisonFile Symbol Ann)
-> m (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        else Maybe (TypecheckedUnisonFile Symbol Ann)
-> m (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing

    pure $
      Mergeblob
        { TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
$sel:conflicts:Mergeblob :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts,
          Maybe (TypecheckedUnisonFile Symbol Ann)
$sel:typecheckedFile:Mergeblob :: Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile :: Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile,
          $sel:unconflictedDefns:Mergeblob :: DefnsF (Map Name) Referent TermReference
unconflictedDefns =
            TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) Referent TermReference
-> DefnsF (Map Name) Referent TermReference
forall term typ.
TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts term typ
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeUnconflictedDefns
              (GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
ThreeWay.gforgetLca Diffblob libdep
blob.declNameLookups)
              TwoWay (DefnsF Set Name Name)
conflictsNames
              Diffblob libdep
blob.unconflicts
              TwoWay (DefnsF Set Name Name)
dependentsNames
              ((BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TermReference Name -> Map Name TermReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF (Map Name) Referent TermReference
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 Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap TermReference Name -> Map Name TermReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range Diffblob libdep
blob.defns.lca.defns),
          $sel:uniqueTypeGuids:Mergeblob :: TwoWay (Map Name Text)
uniqueTypeGuids =
            ((TermReferenceId, Decl Symbol Ann) -> Maybe Text)
-> Map Name (TermReferenceId, Decl Symbol Ann) -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Decl Symbol Ann -> Maybe Text
forall v a. Decl v a -> Maybe Text
DataDeclaration.uniqueTypeGuid (Decl Symbol Ann -> Maybe Text)
-> ((TermReferenceId, Decl Symbol Ann) -> Decl Symbol Ann)
-> (TermReferenceId, Decl Symbol Ann)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermReferenceId, Decl Symbol Ann) -> Decl Symbol Ann
forall a b. (a, b) -> b
snd) (Map Name (TermReferenceId, Decl Symbol Ann) -> Map Name Text)
-> (DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
    -> Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.types)
              (DefnsF
   (Map Name)
   (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
   (TermReferenceId, Decl Symbol Ann)
 -> Map Name Text)
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Map Name Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefnsByName,
          Pretty ColorText
$sel:unparsedFile:Mergeblob :: Pretty ColorText
unparsedFile :: Pretty ColorText
unparsedFile,
          ThreeWay (Pretty ColorText)
$sel:unparsedSoloFiles:Mergeblob :: ThreeWay (Pretty ColorText)
unparsedSoloFiles :: ThreeWay (Pretty ColorText)
unparsedSoloFiles
        }

identifyCoreDependencies ::
  TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
  TwoWay (DefnsF Set TermReferenceId TypeReferenceId) ->
  DefnsF Unconflicts Referent TypeReference ->
  TwoWay (DefnsF Set TermReference TypeReference)
identifyCoreDependencies :: TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set TermReference TermReference)
identifyCoreDependencies TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns TwoWay (DefnsF Set TermReferenceId TermReferenceId)
conflicts DefnsF Unconflicts Referent TermReference
unconflicts = do
  let soloUpdatedNames :: TwoWay (DefnsF Set Name Name)
soloUpdatedNames = DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set Name Name)
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
Unconflicts.soloUpdatedNames DefnsF Unconflicts Referent TermReference
unconflicts
  [TwoWay (DefnsF Set TermReference TermReference)]
-> TwoWay (DefnsF Set TermReference TermReference)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- One source of dependencies: One's own updates (including those that the other party also happened to make).
      -- This is required even though it may seem as though one's already propagated that update. Consider if Alice
      -- updates X and adds a new transitive dependent Z (where Z calls Y calls X). We want X as an Alice core
      -- dependency, not just a B one, so that any update to Y can ultimately propagate again to Z.
      --
      -- Second source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa.
      -- (This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if
      -- anything), no matter what its hash is.)
      let f :: (Ord ref) => Set Name -> Set Name -> Set Name -> BiMultimap ref Name -> BiMultimap ref Name
          f :: forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f Set Name
myUpdates Set Name
bothUpdates Set Name
theirDeletesAndUpdates =
            Set Name -> BiMultimap ref Name -> BiMultimap ref Name
forall a b.
(Ord a, Ord b) =>
Set b -> BiMultimap a b -> BiMultimap a b
BiMultimap.restrictRan ([Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Name
myUpdates, Set Name
bothUpdates, Set Name
theirDeletesAndUpdates])
       in Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF Set TermReference TermReference
forall name.
Defns (BiMultimap Referent name) (BiMultimap TermReference name)
-> DefnsF Set TermReference TermReference
defnsReferences
            (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
 -> DefnsF Set TermReference TermReference)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReference TermReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Set Name
 -> Set Name
 -> Set Name
 -> BiMultimap Referent Name
 -> BiMultimap Referent Name)
-> (Set Name
    -> Set Name
    -> Set Name
    -> BiMultimap TermReference Name
    -> BiMultimap TermReference Name)
-> DefnsF Set Name Name
-> DefnsF Set Name Name
-> DefnsF Set Name Name
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
forall tm1 tm2 tm3 tm4 tm5 ty1 ty2 ty3 ty4 ty5.
(tm1 -> tm2 -> tm3 -> tm4 -> tm5)
-> (ty1 -> ty2 -> ty3 -> ty4 -> ty5)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
-> Defns tm5 ty5
zipDefnsWith4 Set Name
-> Set Name
-> Set Name
-> BiMultimap Referent Name
-> BiMultimap Referent Name
forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f Set Name
-> Set Name
-> Set Name
-> BiMultimap TermReference Name
-> BiMultimap TermReference Name
forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f
                    (DefnsF Set Name Name
 -> DefnsF Set Name Name
 -> DefnsF Set Name Name
 -> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
 -> Defns
      (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set Name Name)
-> TwoWay
     (DefnsF Set Name Name
      -> DefnsF Set Name Name
      -> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
      -> Defns
           (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF Set Name Name)
soloUpdatedNames
                    TwoWay
  (DefnsF Set Name Name
   -> DefnsF Set Name Name
   -> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
   -> Defns
        (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set Name Name)
-> TwoWay
     (DefnsF Set Name Name
      -> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
      -> Defns
           (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DefnsF Set Name Name -> TwoWay (DefnsF Set Name Name)
forall a. a -> TwoWay a
TwoWay.bothWays (DefnsF Unconflicts Referent TermReference -> DefnsF Set Name Name
forall term typ.
DefnsF Unconflicts term typ -> DefnsF Set Name Name
Unconflicts.bothUpdatedNames DefnsF Unconflicts Referent TermReference
unconflicts)
                    TwoWay
  (DefnsF Set Name Name
   -> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
   -> Defns
        (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set Name Name)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
      -> Defns
           (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF Set Name Name) -> TwoWay (DefnsF Set Name Name)
forall a. TwoWay a -> TwoWay a
TwoWay.swap (DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set Name Name)
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
Unconflicts.soloDeletedNames DefnsF Unconflicts Referent TermReference
unconflicts TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name) -> TwoWay (DefnsF Set Name Name)
forall a. Semigroup a => a -> a -> a
<> TwoWay (DefnsF Set Name Name)
soloUpdatedNames)
                    TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
   -> Defns
        (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns
                ),
      -- Third source of dependencies: Alice's own conflicted things, and ditto for Bob.
      --
      -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose
      -- Alice has bar#bar that depends on foo#alice.
      --
      -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these
      -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar.
      --
      -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly
      -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on
      -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so
      -- that when that conflict is resolved, it will propagate to bar.
      (Set TermReferenceId -> Set TermReference)
-> (Set TermReferenceId -> Set TermReference)
-> DefnsF Set TermReferenceId TermReferenceId
-> DefnsF Set TermReference TermReference
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 ((TermReferenceId -> TermReference)
-> Set TermReferenceId -> Set TermReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermReferenceId -> TermReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId) ((TermReferenceId -> TermReference)
-> Set TermReferenceId -> Set TermReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermReferenceId -> TermReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId) (DefnsF Set TermReferenceId TermReferenceId
 -> DefnsF Set TermReference TermReference)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReference TermReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
conflicts
    ]

defnsReferences ::
  Defns (BiMultimap Referent name) (BiMultimap TypeReference name) ->
  DefnsF Set TermReference TypeReference
defnsReferences :: forall name.
Defns (BiMultimap Referent name) (BiMultimap TermReference name)
-> DefnsF Set TermReference TermReference
defnsReferences Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns =
  (DefnsF Set TermReference TermReference
 -> Referent -> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
-> [Referent]
-> DefnsF Set TermReference TermReference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' DefnsF Set TermReference TermReference
-> Referent -> DefnsF Set TermReference TermReference
f Defns {$sel:terms:Defns :: Set TermReference
terms = Set TermReference
forall a. Set a
Set.empty, $sel:types:Defns :: Set TermReference
types = BiMultimap TermReference name -> Set TermReference
forall a b. BiMultimap a b -> Set a
BiMultimap.dom Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns.types} (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (BiMultimap Referent name -> Set Referent
forall a b. BiMultimap a b -> Set a
BiMultimap.dom Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns.terms))
  where
    f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference
    f :: DefnsF Set TermReference TermReference
-> Referent -> DefnsF Set TermReference TermReference
f DefnsF Set TermReference TermReference
acc = \case
      Referent.Con (ConstructorReference TermReference
ref ConstructorId
_) ConstructorType
_ ->
        let !types :: Set TermReference
types = TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReference
ref DefnsF Set TermReference TermReference
acc.types
         in Defns {$sel:terms:Defns :: Set TermReference
terms = DefnsF Set TermReference TermReference
acc.terms, Set TermReference
$sel:types:Defns :: Set TermReference
types :: Set TermReference
types}
      Referent.Ref TermReference
ref ->
        let !terms :: Set TermReference
terms = TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReference
ref DefnsF Set TermReference TermReference
acc.terms
         in Defns {Set TermReference
$sel:terms:Defns :: Set TermReference
terms :: Set TermReference
terms, $sel:types:Defns :: Set TermReference
types = DefnsF Set TermReference TermReference
acc.types}

mergeDependents ::
  forall term typ.
  TwoWay (DefnsF Set Name Name) ->
  DefnsF Unconflicts typ term ->
  TwoWay (DefnsF Set Name Name) ->
  TwoWay (DefnsF Set Name Name)
mergeDependents :: forall term typ.
TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts typ term
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
mergeDependents TwoWay (DefnsF Set Name Name)
conflicts DefnsF Unconflicts typ term
unconflicts TwoWay (DefnsF Set Name Name)
dependents =
  let merge :: Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Map Name ())) (TwoWay (Map Name ()))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
merge = (TwoWay (Set Name)
 -> TwoWay (Set Name)
 -> TwoWay (Set Name)
 -> TwoWay (Map Name ())
 -> Map Name (EitherWay ()))
-> (TwoWay (Set Name)
    -> TwoWay (Set Name)
    -> TwoWay (Set Name)
    -> TwoWay (Map Name ())
    -> Map Name (EitherWay ()))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Map Name ())) (TwoWay (Map Name ()))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
forall tm1 tm2 tm3 tm4 tm5 ty1 ty2 ty3 ty4 ty5.
(tm1 -> tm2 -> tm3 -> tm4 -> tm5)
-> (ty1 -> ty2 -> ty3 -> ty4 -> ty5)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
-> Defns tm5 ty5
zipDefnsWith4 TwoWay (Set Name)
-> TwoWay (Set Name)
-> TwoWay (Set Name)
-> TwoWay (Map Name ())
-> Map Name (EitherWay ())
forall name.
Ord name =>
TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Map name ())
-> Map name (EitherWay ())
mergeDependentsV TwoWay (Set Name)
-> TwoWay (Set Name)
-> TwoWay (Set Name)
-> TwoWay (Map Name ())
-> Map Name (EitherWay ())
forall name.
Ord name =>
TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Map name ())
-> Map name (EitherWay ())
mergeDependentsV
      split :: Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (DefnsF Set Name Name)
split = (Map Name (EitherWay ()) -> TwoWay (Set Name))
-> (Map Name (EitherWay ()) -> TwoWay (Set Name))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (DefnsF Set Name Name)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Map Name (EitherWay ()) -> TwoWay (Set Name)
splitV Map Name (EitherWay ()) -> TwoWay (Set Name)
splitV
   in Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (DefnsF Set Name Name)
split (Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
 -> TwoWay (DefnsF Set Name Name))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (DefnsF Set Name Name)
forall a b. (a -> b) -> a -> b
$
        Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
-> Defns (TwoWay (Map Name ())) (TwoWay (Map Name ()))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
merge
          (TwoWay (DefnsF Set Name Name)
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns TwoWay (DefnsF Set Name Name)
conflicts)
          (TwoWay (DefnsF Set Name Name)
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns (DefnsF Unconflicts typ term -> TwoWay (DefnsF Set Name Name)
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
Unconflicts.soloDeletedNames DefnsF Unconflicts typ term
unconflicts))
          (TwoWay (DefnsF Set Name Name)
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns (DefnsF Unconflicts typ term -> TwoWay (DefnsF Set Name Name)
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name)
Unconflicts.soloUpdatedNames DefnsF Unconflicts typ term
unconflicts))
          (TwoWay (Defns (Map Name ()) (Map Name ()))
-> Defns (TwoWay (Map Name ())) (TwoWay (Map Name ()))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns ((Set Name -> Map Name ())
-> (Set Name -> Map Name ())
-> DefnsF Set Name Name
-> Defns (Map Name ()) (Map 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 ((Name -> ()) -> Set Name -> Map Name ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> Name -> ()
forall a b. a -> b -> a
const ())) ((Name -> ()) -> Set Name -> Map Name ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> Name -> ()
forall a b. a -> b -> a
const ())) (DefnsF Set Name Name -> Defns (Map Name ()) (Map Name ()))
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (Defns (Map Name ()) (Map Name ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF Set Name Name)
dependents))
  where
    splitV :: Map Name (EitherWay ()) -> TwoWay (Set Name)
    splitV :: Map Name (EitherWay ()) -> TwoWay (Set Name)
splitV =
      (TwoWay (Set Name) -> Name -> EitherWay () -> TwoWay (Set Name))
-> TwoWay (Set Name)
-> Map Name (EitherWay ())
-> TwoWay (Set Name)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
        ( \TwoWay (Set Name)
acc Name
name -> \case
            EitherWay.Alice () -> let !alice :: Set Name
alice = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name TwoWay (Set Name)
acc.alice in TwoWay {Set Name
alice :: Set Name
$sel:alice:TwoWay :: Set Name
alice, $sel:bob:TwoWay :: Set Name
bob = TwoWay (Set Name)
acc.bob}
            EitherWay.Bob () -> let !bob :: Set Name
bob = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name TwoWay (Set Name)
acc.bob in TwoWay {$sel:alice:TwoWay :: Set Name
alice = TwoWay (Set Name)
acc.alice, Set Name
$sel:bob:TwoWay :: Set Name
bob :: Set Name
bob}
        )
        (Set Name -> Set Name -> TwoWay (Set Name)
forall a. a -> a -> TwoWay a
TwoWay Set Name
forall a. Set a
Set.empty Set Name
forall a. Set a
Set.empty)

-- Merge Alice and Bob dependents together.
--
-- For an Alice dependent,
--
--   1. If it's Alice-conflicted, drop it (since we only want to return *unconflicted* dependents).
--   2. Otherwise, if Bob deleted it, drop it.
--   3. Otherwise, if Bob updated it, use Bob's version.
--   4. Otherwise, either Alice updated it (so use her version) or neither party updated it (so it's synhash-equal, and
--      we can therefore arbitrarily use Alice's).
mergeDependentsV ::
  forall name.
  (Ord name) =>
  TwoWay (Set name) ->
  TwoWay (Set name) ->
  TwoWay (Set name) ->
  TwoWay (Map name ()) ->
  Map name (EitherWay ())
mergeDependentsV :: forall name.
Ord name =>
TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Set name)
-> TwoWay (Map name ())
-> Map name (EitherWay ())
mergeDependentsV TwoWay (Set name)
conflicts TwoWay (Set name)
deletes TwoWay (Set name)
updates =
  (Map name () -> Map name () -> Map name (EitherWay ()))
-> TwoWay (Map name ()) -> Map name (EitherWay ())
forall a b. (a -> a -> b) -> TwoWay a -> b
TwoWay.twoWay ((Map name () -> Map name () -> Map name (EitherWay ()))
 -> TwoWay (Map name ()) -> Map name (EitherWay ()))
-> (Map name () -> Map name () -> Map name (EitherWay ()))
-> TwoWay (Map name ())
-> Map name (EitherWay ())
forall a b. (a -> b) -> a -> b
$
    SimpleWhenMissing name () (EitherWay ())
-> SimpleWhenMissing name () (EitherWay ())
-> SimpleWhenMatched name () () (EitherWay ())
-> Map name ()
-> Map name ()
-> Map name (EitherWay ())
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
      ((name -> () -> Maybe (EitherWay ()))
-> SimpleWhenMissing name () (EitherWay ())
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing name -> () -> Maybe (EitherWay ())
onlyAlice)
      ((name -> () -> Maybe (EitherWay ()))
-> SimpleWhenMissing name () (EitherWay ())
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing name -> () -> Maybe (EitherWay ())
onlyBob)
      ((name -> () -> () -> Maybe (EitherWay ()))
-> SimpleWhenMatched name () () (EitherWay ())
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched name -> () -> () -> Maybe (EitherWay ())
aliceAndBob)
  where
    onlyAlice :: name -> () -> Maybe (EitherWay ())
    onlyAlice :: name -> () -> Maybe (EitherWay ())
onlyAlice name
name ()
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
conflicts.alice = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
deletes.bob = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
updates.bob = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Bob ())
      | Bool
otherwise = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Alice ())

    onlyBob :: name -> () -> Maybe (EitherWay ())
    onlyBob :: name -> () -> Maybe (EitherWay ())
onlyBob name
name ()
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
conflicts.bob = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
deletes.alice = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
updates.alice = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Alice ())
      | Bool
otherwise = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Bob ())

    aliceAndBob :: name -> () -> () -> Maybe (EitherWay ())
    aliceAndBob :: name -> () -> () -> Maybe (EitherWay ())
aliceAndBob name
name () ()
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
conflicts.alice = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
conflicts.bob = Maybe (EitherWay ())
forall a. Maybe a
Nothing
      | name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member name
name TwoWay (Set name)
updates.bob = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Bob ())
      | Bool
otherwise = EitherWay () -> Maybe (EitherWay ())
forall a. a -> Maybe a
Just (() -> EitherWay ()
forall a. a -> EitherWay a
EitherWay.Alice ())

nameHydratedRefs ::
  Defns (Map TermReferenceId term) (Map TypeReferenceId typ) ->
  DefnsF (Map name) Referent TypeReference ->
  DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefs :: forall term typ name.
Defns (Map TermReferenceId term) (Map TermReferenceId typ)
-> DefnsF (Map name) Referent TermReference
-> DefnsF (Map name) (TermReferenceId, term) (TermReferenceId, typ)
nameHydratedRefs =
  (Map TermReferenceId term
 -> Map name Referent -> Map name (TermReferenceId, term))
-> (Map TermReferenceId typ
    -> Map name TermReference -> Map name (TermReferenceId, typ))
-> Defns (Map TermReferenceId term) (Map TermReferenceId typ)
-> Defns (Map name Referent) (Map name TermReference)
-> Defns
     (Map name (TermReferenceId, term))
     (Map name (TermReferenceId, typ))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith ((Referent -> Maybe TermReferenceId)
-> Map TermReferenceId term
-> Map name Referent
-> Map name (TermReferenceId, term)
forall defn term name.
(defn -> Maybe TermReferenceId)
-> Map TermReferenceId term
-> Map name defn
-> Map name (TermReferenceId, term)
f Referent -> Maybe TermReferenceId
Referent.toTermReferenceId) ((TermReference -> Maybe TermReferenceId)
-> Map TermReferenceId typ
-> Map name TermReference
-> Map name (TermReferenceId, typ)
forall defn term name.
(defn -> Maybe TermReferenceId)
-> Map TermReferenceId term
-> Map name defn
-> Map name (TermReferenceId, term)
f TermReference -> Maybe TermReferenceId
Reference.toId)
  where
    f :: (defn -> Maybe Reference.Id) -> Map Reference.Id term -> Map name defn -> Map name (Reference.Id, term)
    f :: forall defn term name.
(defn -> Maybe TermReferenceId)
-> Map TermReferenceId term
-> Map name defn
-> Map name (TermReferenceId, term)
f defn -> Maybe TermReferenceId
toId Map TermReferenceId term
refToDefn Map name defn
nameToRef =
      (defn -> Maybe (TermReferenceId, term))
-> Map name defn -> Map name (TermReferenceId, term)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (defn -> Maybe TermReferenceId
toId (defn -> Maybe TermReferenceId)
-> (TermReferenceId -> Maybe (TermReferenceId, term))
-> defn
-> Maybe (TermReferenceId, term)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \TermReferenceId
ref -> (TermReferenceId
ref,) (term -> (TermReferenceId, term))
-> Maybe term -> Maybe (TermReferenceId, term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TermReferenceId -> Map TermReferenceId term -> Maybe term
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId term
refToDefn) Map name defn
nameToRef

makeUnconflictedDefns ::
  TwoWay DeclNameLookup ->
  TwoWay (DefnsF Set Name Name) ->
  DefnsF Unconflicts term typ ->
  TwoWay (DefnsF Set Name Name) ->
  DefnsF (Map Name) term typ ->
  DefnsF (Map Name) term typ
makeUnconflictedDefns :: forall term typ.
TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts term typ
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeUnconflictedDefns TwoWay DeclNameLookup
declNameLookups TwoWay (DefnsF Set Name Name)
conflicts DefnsF Unconflicts term typ
unconflicts TwoWay (DefnsF Set Name Name)
dependents =
  (Unconflicts term -> Set Name -> Map Name term -> Map Name term)
-> (Unconflicts typ -> Set Name -> Map Name typ -> Map Name typ)
-> DefnsF Unconflicts term typ
-> DefnsF Set Name Name
-> Defns (Map Name term) (Map Name typ)
-> Defns (Map Name term) (Map Name typ)
forall tm1 tm2 tm3 tm4 ty1 ty2 ty3 ty4.
(tm1 -> tm2 -> tm3 -> tm4)
-> (ty1 -> ty2 -> ty3 -> ty4)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
zipDefnsWith3 Unconflicts term -> Set Name -> Map Name term -> Map Name term
forall v. Unconflicts v -> Set Name -> Map Name v -> Map Name v
makeStageOneV Unconflicts typ -> Set Name -> Map Name typ -> Map Name typ
forall v. Unconflicts v -> Set Name -> Map Name v -> Map Name v
makeStageOneV DefnsF Unconflicts term typ
unconflicts (TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
f TwoWay (DefnsF Set Name Name)
conflicts DefnsF Set Name Name
-> DefnsF Set Name Name -> DefnsF Set Name Name
forall a. Semigroup a => a -> a -> a
<> TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
f TwoWay (DefnsF Set Name Name)
dependents)
  where
    f :: TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
    f :: TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
f TwoWay (DefnsF Set Name Name)
defns =
      TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
forall m. Monoid m => TwoWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name
refIdsToNames (DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name)
-> TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name -> DefnsF Set Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DeclNameLookup
declNameLookups TwoWay (DefnsF Set Name Name -> DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name) -> TwoWay (DefnsF Set Name Name)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF Set Name Name)
defns)

makeStageOneV :: Unconflicts v -> Set Name -> Map Name v -> Map Name v
makeStageOneV :: forall v. Unconflicts v -> Set Name -> Map Name v -> Map Name v
makeStageOneV Unconflicts v
unconflicts Set Name
namesToDelete =
  (Map Name v -> Set Name -> Map Name v
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set Name
namesToDelete) (Map Name v -> Map Name v)
-> (Map Name v -> Map Name v) -> Map Name v -> Map Name v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unconflicts v -> Map Name v -> Map Name v
forall v. Unconflicts v -> Map Name v -> Map Name v
Unconflicts.apply Unconflicts v
unconflicts

-- Given just named term/type reference ids, fill out all names that occupy the term and type namespaces. This is simply
-- the given names plus all of the types' constructors.
--
-- For example, if the input is
--
--   declNameLookup = {
--     "Maybe" => ["Maybe.Nothing", "Maybe.Just"]
--   }
--   defns = {
--     terms = { "foo" => #foo }
--     types = { "Maybe" => #Maybe }
--   }
--
-- then the output is
--
--   defns = {
--     terms = { "foo", "Maybe.Nothing", "Maybe.Just" }
--     types = { "Maybe" }
--   }
refIdsToNames :: DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name
refIdsToNames :: DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name
refIdsToNames DeclNameLookup
declNameLookup =
  (Set Name -> DefnsF Set Name Name)
-> (Set Name -> DefnsF Set Name Name)
-> DefnsF Set Name Name
-> DefnsF Set Name Name
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap Set Name -> DefnsF Set Name Name
goTerms Set Name -> DefnsF Set Name Name
goTypes
  where
    goTerms :: Set Name -> DefnsF Set Name Name
    goTerms :: Set Name -> DefnsF Set Name Name
goTerms Set Name
terms =
      Defns {Set Name
$sel:terms:Defns :: Set Name
terms :: Set Name
terms, $sel:types:Defns :: Set Name
types = Set Name
forall a. Set a
Set.empty}

    goTypes :: Set Name -> DefnsF Set Name Name
    goTypes :: Set Name -> DefnsF Set Name Name
goTypes Set Name
types =
      Defns
        { $sel:terms:Defns :: Set Name
terms = (Name -> Set Name) -> Set Name -> Set Name
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> (Name -> [Name]) -> Name -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
DeclNameLookup.expectConstructorNames DeclNameLookup
declNameLookup) Set Name
types,
          Set Name
$sel:types:Defns :: Set Name
types :: Set Name
types
        }