module Unison.Merge.Mergeblob3
  ( Mergeblob3 (..),
    makeMergeblob3,
  )
where

import Control.Lens (mapped)
import Data.Align (align)
import Data.Bifoldable (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 Data.Text qualified as Text
import Data.These (These (..))
import Data.Zip (unzip)
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DeclNameLookup (DeclNameLookup (..), expectConstructorNames)
import Unison.DeclNameLookup qualified as DeclNameLookup
import Unison.Merge.EitherWay (EitherWay)
import Unison.Merge.EitherWay qualified as EitherWay
import Unison.Merge.Mergeblob2 (Mergeblob2 (..))
import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..))
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.Name (Name)
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile)
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith, zipDefnsWith3, zipDefnsWith4)
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Prelude hiding (unzip)

data Mergeblob3 = Mergeblob3
  { Mergeblob3 -> Names
libdeps :: Names,
    Mergeblob3 -> DefnsF (Map Name) Referent TypeReference
stageOne :: DefnsF (Map Name) Referent TypeReference,
    Mergeblob3 -> DefnsF (Map Name) Referent TypeReference
stageTwo :: DefnsF (Map Name) Referent TypeReference,
    Mergeblob3 -> Map Name Text
uniqueTypeGuids :: Map Name Text,
    -- `unparsedFile` (no mergetool) xor `unparsedSoloFiles` (yes mergetool) are ultimately given to the user
    Mergeblob3 -> Pretty ColorText
unparsedFile :: Pretty ColorText,
    Mergeblob3 -> ThreeWay (Pretty ColorText)
unparsedSoloFiles :: ThreeWay (Pretty ColorText)
  }

makeMergeblob3 ::
  Mergeblob2 libdep ->
  TwoWay (DefnsF Set TermReferenceId TypeReferenceId) ->
  Names ->
  Names ->
  TwoWay Text ->
  Mergeblob3
makeMergeblob3 :: forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> Names
-> TwoWay Text
-> Mergeblob3
makeMergeblob3 Mergeblob2 libdep
blob TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependentsIds Names
libdeps Names
lcaLibdeps TwoWay Text
authors =
  let -- Project out just the name->ref mapping of defns, since we need it a few times
      defnsByName :: ThreeWay (DefnsF (Map Name) Referent TypeReference)
      defnsByName :: ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName =
        (BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TypeReference Name -> Map Name TypeReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF (Map Name) Referent TypeReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF (Map Name) Referent TypeReference)
-> ThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mergeblob2 libdep
blob.defns

      conflictsNames :: TwoWay (DefnsF Set Name Name)
      conflictsNames :: TwoWay (Defns (Set Name) (Set Name))
conflictsNames =
        (Map Name TermReferenceId -> Set Name)
-> (Map Name TermReferenceId -> Set Name)
-> Defns (Map Name TermReferenceId) (Map Name TermReferenceId)
-> Defns (Set Name) (Set 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 (Defns (Map Name TermReferenceId) (Map Name TermReferenceId)
 -> Defns (Set Name) (Set Name))
-> TwoWay
     (Defns (Map Name TermReferenceId) (Map Name TermReferenceId))
-> TwoWay (Defns (Set Name) (Set Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mergeblob2 libdep
blob.conflicts

      -- Compute the set of dependents names
      allDependentsNames :: TwoWay (DefnsF Set Name Name)
      allDependentsNames :: TwoWay (Defns (Set Name) (Set Name))
allDependentsNames =
        (BiMultimap Referent Name -> Set TermReferenceId -> Set Name)
-> (BiMultimap TypeReference Name
    -> Set TermReferenceId -> Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> DefnsF Set TermReferenceId TermReferenceId
-> Defns (Set Name) (Set 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 TypeReference Name
defns Set TermReferenceId
deps -> (TypeReference -> NESet Name -> Set Name)
-> Map TypeReference (NESet Name) -> Set Name
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (Set TermReferenceId -> TypeReference -> NESet Name -> Set Name
g Set TermReferenceId
deps) (BiMultimap TypeReference Name -> Map TypeReference (NESet Name)
forall a b. BiMultimap a b -> Map a (NESet b)
BiMultimap.domain BiMultimap TypeReference Name
defns))
          (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> DefnsF Set TermReferenceId TermReferenceId
 -> Defns (Set Name) (Set Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (DefnsF Set TermReferenceId TermReferenceId
      -> Defns (Set Name) (Set Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Mergeblob2 libdep
blob.defns
          TwoWay
  (DefnsF Set TermReferenceId TermReferenceId
   -> Defns (Set Name) (Set Name))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (Defns (Set Name) (Set 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 -> TypeReference -> NESet Name -> Set Name
g Set TermReferenceId
deps TypeReference
defn0 NESet Name
names
            | ReferenceDerived TermReferenceId
defn <- TypeReference
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

      -- 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)
      dependents :: TwoWay (DefnsF Set Name Name)
      dependents :: TwoWay (Defns (Set Name) (Set Name))
dependents =
        TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts Referent TypeReference
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
forall term typ.
TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts typ term
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
mergeDependents TwoWay (Defns (Set Name) (Set Name))
conflictsNames Mergeblob2 libdep
blob.unconflicts TwoWay (Defns (Set Name) (Set Name))
allDependentsNames

      ppe :: PrettyPrintEnvDecl
      ppe :: PrettyPrintEnvDecl
ppe =
        ThreeWay Names -> Names -> Names -> PrettyPrintEnvDecl
makePrettyPrintEnv
          (DefnsF (Map Name) Referent TypeReference -> Names
Names.fromUnconflicted (DefnsF (Map Name) Referent TypeReference -> Names)
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> ThreeWay Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName)
          Names
libdeps
          Names
lcaLibdeps

      renderedConflicts :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
      renderedDependents :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
      (TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedConflicts, TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedDependents) =
        TwoWay DeclNameLookup
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
renderConflictsAndDependents
          Mergeblob2 libdep
blob.declNameLookups
          (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 Mergeblob2 libdep
blob.hydratedDefns)
          TwoWay (Defns (Set Name) (Set Name))
conflictsNames
          TwoWay (Defns (Set Name) (Set Name))
dependents
          PrettyPrintEnvDecl
ppe

      renderedLcaConflicts :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
      renderedLcaConflicts :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderedLcaConflicts =
        PartialDeclNameLookup
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts
          Mergeblob2 libdep
blob.lcaDeclNameLookup
          Mergeblob2 libdep
blob.hydratedDefns.lca
          TwoWay (Defns (Set Name) (Set Name))
conflictsNames
          PrettyPrintEnvDecl
ppe
   in Mergeblob3
        { Names
$sel:libdeps:Mergeblob3 :: Names
libdeps :: Names
libdeps,
          $sel:stageOne:Mergeblob3 :: DefnsF (Map Name) Referent TypeReference
stageOne = TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts Referent TypeReference
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF (Map Name) Referent TypeReference
forall term typ.
TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts term typ
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeStageOne Mergeblob2 libdep
blob.declNameLookups TwoWay (Defns (Set Name) (Set Name))
conflictsNames Mergeblob2 libdep
blob.unconflicts TwoWay (Defns (Set Name) (Set Name))
dependents ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName.lca,
          $sel:stageTwo:Mergeblob3 :: DefnsF (Map Name) Referent TypeReference
stageTwo = TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts Referent TypeReference
-> TwoWay (Defns (Set Name) (Set Name))
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> DefnsF (Map Name) Referent TypeReference
forall term typ.
TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts term typ
-> TwoWay (Defns (Set Name) (Set Name))
-> ThreeWay (DefnsF (Map Name) term typ)
-> DefnsF (Map Name) term typ
makeStageTwo Mergeblob2 libdep
blob.declNameLookups TwoWay (Defns (Set Name) (Set Name))
conflictsNames Mergeblob2 libdep
blob.unconflicts TwoWay (Defns (Set Name) (Set Name))
dependents ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName,
          $sel:uniqueTypeGuids:Mergeblob3 :: Map Name Text
uniqueTypeGuids = TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> Map Name Text
makeUniqueTypeGuids (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 Mergeblob2 libdep
blob.hydratedDefns),
          $sel:unparsedFile:Mergeblob3 :: Pretty ColorText
unparsedFile = TwoWay Text
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettyUnisonFile TwoWay Text
authors TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedConflicts TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedDependents,
          $sel:unparsedSoloFiles:Mergeblob3 :: ThreeWay (Pretty ColorText)
unparsedSoloFiles =
            ThreeWay
              { $sel:alice:ThreeWay :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
alice = TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedConflicts.alice,
                $sel:bob:ThreeWay :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
bob = TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedConflicts.bob,
                $sel:lca:ThreeWay :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
lca = DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderedLcaConflicts
              }
              ThreeWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
    -> Pretty ColorText)
-> ThreeWay (Pretty ColorText)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
conflicts -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettySoloUnisonFile DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
conflicts TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
renderedDependents
        }

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 (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts typ term
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
mergeDependents TwoWay (Defns (Set Name) (Set Name))
conflicts DefnsF Unconflicts typ term
unconflicts TwoWay (Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name))
split = (Map Name (EitherWay ()) -> TwoWay (Set Name))
-> (Map Name (EitherWay ()) -> TwoWay (Set Name))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name))
split (Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
 -> TwoWay (Defns (Set Name) (Set Name)))
-> Defns (Map Name (EitherWay ())) (Map Name (EitherWay ()))
-> TwoWay (Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name))
-> Defns (TwoWay (Set Name)) (TwoWay (Set Name))
forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
TwoWay.sequenceDefns TwoWay (Defns (Set Name) (Set Name))
conflicts)
          (TwoWay (Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name))
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (Defns (Set Name) (Set Name))
Unconflicts.soloDeletedNames DefnsF Unconflicts typ term
unconflicts))
          (TwoWay (Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name))
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (Defns (Set Name) (Set 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 ())
-> Defns (Set Name) (Set 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 ())) (Defns (Set Name) (Set Name) -> Defns (Map Name ()) (Map Name ()))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Map Name ()) (Map Name ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Set Name) (Set 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 ())

makeStageOne ::
  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
makeStageOne :: forall term typ.
TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts term typ
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeStageOne TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Set Name) (Set Name))
conflicts DefnsF Unconflicts term typ
unconflicts TwoWay (Defns (Set Name) (Set 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
-> Defns (Set Name) (Set 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 (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
f TwoWay (Defns (Set Name) (Set Name))
conflicts Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name)
forall a. Semigroup a => a -> a -> a
<> TwoWay (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
f TwoWay (Defns (Set Name) (Set Name))
dependents)
  where
    f :: TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name
    f :: TwoWay (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
f TwoWay (Defns (Set Name) (Set Name))
defns =
      TwoWay (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
forall m. Monoid m => TwoWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (DeclNameLookup
-> Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name)
refIdsToNames (DeclNameLookup
 -> Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name))
-> TwoWay DeclNameLookup
-> TwoWay
     (Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set 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 (Set Name) (Set 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

makeStageTwo ::
  forall term typ.
  TwoWay DeclNameLookup ->
  TwoWay (DefnsF Set Name Name) ->
  DefnsF Unconflicts term typ ->
  TwoWay (DefnsF Set Name Name) ->
  ThreeWay (DefnsF (Map Name) term typ) ->
  DefnsF (Map Name) term typ
makeStageTwo :: forall term typ.
TwoWay DeclNameLookup
-> TwoWay (Defns (Set Name) (Set Name))
-> DefnsF Unconflicts term typ
-> TwoWay (Defns (Set Name) (Set Name))
-> ThreeWay (DefnsF (Map Name) term typ)
-> DefnsF (Map Name) term typ
makeStageTwo TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Set Name) (Set Name))
conflicts DefnsF Unconflicts term typ
unconflicts TwoWay (Defns (Set Name) (Set Name))
dependents ThreeWay (DefnsF (Map Name) term typ)
defns =
  (Map Name term
 -> Map Name term
 -> Unconflicts term
 -> Map Name term
 -> Map Name term)
-> (Map Name typ
    -> Map Name typ -> Unconflicts typ -> Map Name typ -> Map Name typ)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
-> DefnsF Unconflicts term typ
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
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 Map Name term
-> Map Name term
-> Unconflicts term
-> Map Name term
-> Map Name term
forall v.
Map Name v
-> Map Name v -> Unconflicts v -> Map Name v -> Map Name v
makeStageTwoV Map Name typ
-> Map Name typ -> Unconflicts typ -> Map Name typ -> Map Name typ
forall v.
Map Name v
-> Map Name v -> Unconflicts v -> Map Name v -> Map Name v
makeStageTwoV ThreeWay (DefnsF (Map Name) term typ)
defns.lca DefnsF (Map Name) term typ
aliceBiasedDependents DefnsF Unconflicts term typ
unconflicts DefnsF (Map Name) term typ
aliceConflicts
  where
    aliceConflicts :: DefnsF (Map Name) term typ
    aliceConflicts :: DefnsF (Map Name) term typ
aliceConflicts =
      (Map Name term -> Set Name -> Map Name term)
-> (Map Name typ -> Set Name -> Map Name typ)
-> DefnsF (Map Name) term typ
-> Defns (Set Name) (Set Name)
-> DefnsF (Map Name) term typ
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 term
defns Set Name
conflicts -> Map Name term -> Set Name -> Map Name term
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name term
defns (Set Name
conflicts Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
aliceConstructorsOfTypeConflicts))
        Map Name typ -> Set Name -> Map Name typ
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys
        ThreeWay (DefnsF (Map Name) term typ)
defns.alice
        TwoWay (Defns (Set Name) (Set Name))
conflicts.alice

    aliceConstructorsOfTypeConflicts :: Set Name
    aliceConstructorsOfTypeConflicts :: Set Name
aliceConstructorsOfTypeConflicts =
      (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 TwoWay DeclNameLookup
declNameLookups.alice)
        TwoWay (Defns (Set Name) (Set Name))
conflicts.alice.types

    aliceBiasedDependents :: DefnsF (Map Name) term typ
    aliceBiasedDependents :: DefnsF (Map Name) term typ
aliceBiasedDependents =
      (DefnsF (Map Name) term typ
 -> DefnsF (Map Name) term typ -> DefnsF (Map Name) term typ)
-> TwoWay (DefnsF (Map Name) term typ)
-> DefnsF (Map Name) term typ
forall a b. (a -> a -> b) -> TwoWay a -> b
TwoWay.twoWay
        ((Map Name term -> Map Name term -> Map Name term)
-> (Map Name typ -> Map Name typ -> Map Name typ)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith ((term -> term -> term)
-> Map Name term -> Map Name term -> Map Name term
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith term -> term -> term
forall a b. a -> b -> a
const) ((typ -> typ -> typ) -> Map Name typ -> Map Name typ -> Map Name typ
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith typ -> typ -> typ
forall a b. a -> b -> a
const))
        ((Map Name term -> Set Name -> Map Name term)
-> (Map Name typ -> Set Name -> Map Name typ)
-> DefnsF (Map Name) term typ
-> Defns (Set Name) (Set Name)
-> DefnsF (Map Name) term typ
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 term -> Set Name -> Map Name term
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name typ -> Set Name -> Map Name typ
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (DefnsF (Map Name) term typ
 -> Defns (Set Name) (Set Name) -> DefnsF (Map Name) term typ)
-> TwoWay (DefnsF (Map Name) term typ)
-> TwoWay
     (Defns (Set Name) (Set Name) -> DefnsF (Map Name) term typ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF (Map Name) term typ)
-> TwoWay (DefnsF (Map Name) term typ)
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay (DefnsF (Map Name) term typ)
defns TwoWay (Defns (Set Name) (Set Name) -> DefnsF (Map Name) term typ)
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (DefnsF (Map Name) term typ)
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 (Set Name) (Set Name))
dependents)

makeStageTwoV :: Map Name v -> Map Name v -> Unconflicts v -> Map Name v -> Map Name v
makeStageTwoV :: forall v.
Map Name v
-> Map Name v -> Unconflicts v -> Map Name v -> Map Name v
makeStageTwoV Map Name v
lcaDefns Map Name v
dependents Unconflicts v
unconflicts Map Name v
conflicts =
  (v -> v -> v) -> Map Name v -> Map Name v -> Map Name v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith v -> v -> v
forall a b. a -> b -> a
const Map Name v
dependents Map Name v
lcaDefns
    Map Name v -> (Map Name v -> Map Name v) -> Map Name v
forall a b. a -> (a -> b) -> b
& Unconflicts v -> Map Name v -> Map Name v
forall v. Unconflicts v -> Map Name v -> Map Name v
Unconflicts.apply Unconflicts v
unconflicts
    Map Name v -> (Map Name v -> Map Name v) -> Map Name v
forall a b. a -> (a -> b) -> b
& (v -> v -> v) -> Map Name v -> Map Name v -> Map Name v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith v -> v -> v
forall a b. a -> b -> a
const Map Name v
conflicts

-- 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
-> Defns (Set Name) (Set Name) -> Defns (Set Name) (Set Name)
refIdsToNames DeclNameLookup
declNameLookup =
  (Set Name -> Defns (Set Name) (Set Name))
-> (Set Name -> Defns (Set Name) (Set Name))
-> Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set 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 -> Defns (Set Name) (Set Name)
goTerms Set Name -> Defns (Set Name) (Set Name)
goTypes
  where
    goTerms :: Set Name -> DefnsF Set Name Name
    goTerms :: Set Name -> Defns (Set Name) (Set Name)
goTerms Set Name
terms =
      Defns {Set Name
terms :: Set Name
$sel:terms:Defns :: 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 -> Defns (Set Name) (Set 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]
expectConstructorNames DeclNameLookup
declNameLookup) Set Name
types,
          Set Name
$sel:types:Defns :: Set Name
types :: Set Name
types
        }

renderConflictsAndDependents ::
  TwoWay DeclNameLookup ->
  TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) ->
  TwoWay (DefnsF Set Name Name) ->
  TwoWay (DefnsF Set Name Name) ->
  PrettyPrintEnvDecl ->
  ( TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
  )
renderConflictsAndDependents :: TwoWay DeclNameLookup
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
renderConflictsAndDependents TwoWay DeclNameLookup
declNameLookups TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns TwoWay (Defns (Set Name) (Set Name))
conflicts TwoWay (Defns (Set Name) (Set Name))
dependents PrettyPrintEnvDecl
ppe =
  TwoWay
  (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
   DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
forall a b. TwoWay (a, b) -> (TwoWay a, TwoWay b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip (TwoWay
   (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
    DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
 -> (TwoWay
       (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
     TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))))
-> TwoWay
     (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
      DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
forall a b. (a -> b) -> a -> b
$
    ( \DeclNameLookup
declNameLookup (DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
conflicts, DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
dependents) ->
        let render :: Set Name
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
needsGuid = DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (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)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderDefnsForUnisonFile DeclNameLookup
declNameLookup PrettyPrintEnvDecl
ppe Set Name
needsGuid (DefnsF
   (Map Name)
   (Term Symbol Ann, Type Symbol Ann)
   (TermReferenceId, Decl Symbol Ann)
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
    -> DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
  (DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
-> ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> (Term Symbol Ann, Type Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Identity
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
#terms ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
 -> Identity
      (DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TermReferenceId, Decl Symbol Ann)))
-> (((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     -> Identity (Term Symbol Ann, Type Symbol Ann))
    -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> ASetter
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Identity (Map Name (Term Symbol Ann, Type Symbol Ann))
Setter
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (Term Symbol Ann, Type Symbol Ann)
forall a b. (a, b) -> b
snd
         in (Set Name
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
uniqueTypeConflictsWithDifferentGuids DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
conflicts, Set Name
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
forall a. Set a
Set.empty DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
dependents)
    )
      (DeclNameLookup
 -> (DefnsF
       (Map Name)
       (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
       (TermReferenceId, Decl Symbol Ann),
     DefnsF
       (Map Name)
       (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
       (TermReferenceId, Decl Symbol Ann))
 -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
     DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
-> TwoWay DeclNameLookup
-> TwoWay
     ((DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann),
       DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann))
      -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
          DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DeclNameLookup
declNameLookups
      TwoWay
  ((DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann),
    DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann))
   -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
       DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann),
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> TwoWay
     (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
      DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
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
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann),
   DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedConflictsAndDependents
  where
    hydratedConflictsAndDependents ::
      TwoWay
        ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann),
          DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)
        )
    hydratedConflictsAndDependents :: TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann),
   DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedConflictsAndDependents =
      ( \DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
as Defns (Set Name) (Set Name)
bs Defns (Set Name) (Set Name)
cs ->
          ( (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Set Name
 -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
-> (Map Name (TermReferenceId, Decl Symbol Ann)
    -> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Defns (Set Name) (Set Name)
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
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 (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Set Name
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (TermReferenceId, Decl Symbol Ann)
-> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
as Defns (Set Name) (Set Name)
bs,
            (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Set Name
 -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
-> (Map Name (TermReferenceId, Decl Symbol Ann)
    -> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Defns (Set Name) (Set Name)
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
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 (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Set Name
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (TermReferenceId, Decl Symbol Ann)
-> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
as Defns (Set Name) (Set Name)
cs
          )
      )
        (DefnsF
   (Map Name)
   (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
   (TermReferenceId, Decl Symbol Ann)
 -> Defns (Set Name) (Set Name)
 -> Defns (Set Name) (Set Name)
 -> (DefnsF
       (Map Name)
       (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
       (TermReferenceId, Decl Symbol Ann),
     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))
-> TwoWay
     (Defns (Set Name) (Set Name)
      -> Defns (Set Name) (Set Name)
      -> (DefnsF
            (Map Name)
            (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
            (TermReferenceId, Decl Symbol Ann),
          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
<$> TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns
        TwoWay
  (Defns (Set Name) (Set Name)
   -> Defns (Set Name) (Set Name)
   -> (DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann),
       DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann)))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
     (Defns (Set Name) (Set Name)
      -> (DefnsF
            (Map Name)
            (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
            (TermReferenceId, Decl Symbol Ann),
          DefnsF
            (Map Name)
            (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
            (TermReferenceId, Decl Symbol Ann)))
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 (Set Name) (Set Name))
conflicts
        TwoWay
  (Defns (Set Name) (Set Name)
   -> (DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann),
       DefnsF
         (Map Name)
         (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
         (TermReferenceId, Decl Symbol Ann)))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann),
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
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 (Set Name) (Set Name))
dependents

    uniqueTypeConflictsWithDifferentGuids :: Set Name
    uniqueTypeConflictsWithDifferentGuids :: Set Name
uniqueTypeConflictsWithDifferentGuids =
      ((DefnsF
    (Map Name)
    (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    (TermReferenceId, Decl Symbol Ann),
  DefnsF
    (Map Name)
    (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    (TermReferenceId, Decl Symbol Ann))
 -> (DefnsF
       (Map Name)
       (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
       (TermReferenceId, Decl Symbol Ann),
     DefnsF
       (Map Name)
       (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
       (TermReferenceId, Decl Symbol Ann))
 -> Set Name)
-> TwoWay
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann),
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
-> Set Name
forall a b. (a -> a -> b) -> TwoWay a -> b
TwoWay.twoWay
        ( \(DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
aliceConflicts, DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
_) (DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
bobConflicts, DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
_) ->
            Const (Set Name) (Map Name Any) -> Set Name
forall {k} a (b :: k). Const a b -> a
getConst
              ( WhenMissing
  (Const (Set Name)) Name (TermReferenceId, Decl Symbol Ann) Any
-> WhenMissing
     (Const (Set Name)) Name (TermReferenceId, Decl Symbol Ann) Any
-> WhenMatched
     (Const (Set Name))
     Name
     (TermReferenceId, Decl Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
     Any
-> Map Name (TermReferenceId, Decl Symbol Ann)
-> Map Name (TermReferenceId, Decl Symbol Ann)
-> Const (Set Name) (Map Name Any)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
                  WhenMissing
  (Const (Set Name)) Name (TermReferenceId, Decl Symbol Ann) Any
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
                  WhenMissing
  (Const (Set Name)) Name (TermReferenceId, Decl Symbol Ann) Any
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
                  ( (Name
 -> (TermReferenceId, Decl Symbol Ann)
 -> (TermReferenceId, Decl Symbol Ann)
 -> Const (Set Name) Any)
-> WhenMatched
     (Const (Set Name))
     Name
     (TermReferenceId, Decl Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
     Any
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
Map.zipWithAMatched
                      \Name
name (TermReferenceId
_, Decl Symbol Ann
decl1) (TermReferenceId
_, Decl Symbol Ann
decl2) ->
                        Set Name -> Const (Set Name) Any
forall {k} a (b :: k). a -> Const a b
Const
                          case ( DataDeclaration Symbol Ann -> Modifier
forall v a. DataDeclaration v a -> Modifier
DataDeclaration.modifier (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DataDeclaration.asDataDecl Decl Symbol Ann
decl1),
                                 DataDeclaration Symbol Ann -> Modifier
forall v a. DataDeclaration v a -> Modifier
DataDeclaration.modifier (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DataDeclaration.asDataDecl Decl Symbol Ann
decl2)
                               ) of
                            (DataDeclaration.Unique Text
guid1, DataDeclaration.Unique Text
guid2) | Text
guid1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
guid2 -> Name -> Set Name
forall a. a -> Set a
Set.singleton Name
name
                            (Modifier, Modifier)
_ -> Set Name
forall a. Set a
Set.empty
                  )
                  DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
aliceConflicts.types
                  DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
bobConflicts.types
              )
        )
        TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann),
   DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedConflictsAndDependents

renderLcaConflicts ::
  PartialDeclNameLookup ->
  DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) ->
  TwoWay (DefnsF Set Name Name) ->
  PrettyPrintEnvDecl ->
  DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts :: PartialDeclNameLookup
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts PartialDeclNameLookup
partialDeclNameLookup DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedDefns TwoWay (Defns (Set Name) (Set Name))
conflicts PrettyPrintEnvDecl
ppe =
  let hydratedConflicts :: DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedConflicts = (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Set Name
 -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
-> (Map Name (TermReferenceId, Decl Symbol Ann)
    -> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Defns (Set Name) (Set Name)
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
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 (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Set Name
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Name (TermReferenceId, Decl Symbol Ann)
-> Set Name -> Map Name (TermReferenceId, Decl Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedDefns (TwoWay (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
forall m. Monoid m => TwoWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold TwoWay (Defns (Set Name) (Set Name))
conflicts)
   in DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (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)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderDefnsForUnisonFile
        DeclNameLookup
declNameLookup
        PrettyPrintEnvDecl
ppe
        Set Name
forall a. Set a
Set.empty
        (ASetter
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
  (DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
-> ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> (Term Symbol Ann, Type Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Identity
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
#terms ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
 -> Identity
      (DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TermReferenceId, Decl Symbol Ann)))
-> (((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     -> Identity (Term Symbol Ann, Type Symbol Ann))
    -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> ASetter
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Identity (Map Name (Term Symbol Ann, Type Symbol Ann))
Setter
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (Term Symbol Ann, Type Symbol Ann)
forall a b. (a, b) -> b
snd DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedConflicts)
  where
    -- We allow the LCA of a merge to have missing constructor names, yet we do need to render *something* in a file
    -- for a mergetool (if one is configured). So, we make the partial decl name lookup total by making bogus
    -- constructor names as necessary.
    declNameLookup :: DeclNameLookup
    declNameLookup :: DeclNameLookup
declNameLookup =
      DeclNameLookup
        { $sel:constructorToDecl:DeclNameLookup :: Map Name Name
constructorToDecl = PartialDeclNameLookup
partialDeclNameLookup.constructorToDecl,
          $sel:declToConstructors:DeclNameLookup :: Map Name [Name]
declToConstructors =
            [Maybe Name] -> [Name]
makeTotal ([Maybe Name] -> [Name])
-> Map Name [Maybe Name] -> Map Name [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartialDeclNameLookup
partialDeclNameLookup.declToConstructors
        }
      where
        makeTotal :: [Maybe Name] -> [Name]
        makeTotal :: [Maybe Name] -> [Name]
makeTotal [Maybe Name]
names0 =
          case [Maybe Name] -> Maybe [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Maybe Name]
names0 of
            Just [Name]
names -> [Name]
names
            Maybe [Name]
Nothing ->
              (Set Name, [Name]) -> [Name]
forall a b. (a, b) -> b
snd ((Set Name, [Name]) -> [Name]) -> (Set Name, [Name]) -> [Name]
forall a b. (a -> b) -> a -> b
$
                (Set Name -> Maybe Name -> (Set Name, Name))
-> Set Name -> [Maybe Name] -> (Set Name, [Name])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
                  Set Name -> Maybe Name -> (Set Name, Name)
makeSomethingUp
                  ((Maybe Name -> Set Name) -> [Maybe Name] -> Set Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set Name -> (Name -> Set Name) -> Maybe Name -> Set Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Name
forall a. Set a
Set.empty Name -> Set Name
forall a. a -> Set a
Set.singleton) [Maybe Name]
names0)
                  [Maybe Name]
names0
          where
            makeSomethingUp :: Set Name -> Maybe Name -> (Set Name, Name)
            makeSomethingUp :: Set Name -> Maybe Name -> (Set Name, Name)
makeSomethingUp Set Name
taken = \case
              Just Name
name -> (Set Name
taken, Name
name)
              Maybe Name
Nothing ->
                let name :: Name
name = Int -> Text -> Name
freshen Int
0 Text
"Unnamed"
                    !taken1 :: Set Name
taken1 = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name Set Name
taken
                 in (Set Name
taken1, Name
name)
              where
                freshen :: Int -> Text -> Name
                freshen :: Int -> Text -> Name
freshen Int
i Text
name0
                  | Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Name
name Set Name
taken = Int -> Text -> Name
freshen (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
name0
                  | Bool
otherwise = Name
name
                  where
                    name :: Name
                    name :: Name
name =
                      HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText (Text
name0 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
Text.empty else String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i))

-- Create a PPE that uses Alice's names whenever possible, falling back to Bob's names only when Alice doesn't have any,
-- and falling back to the LCA after that.
--
-- This results in a file that "looks familiar" to Alice (the one merging in Bob's changes), and avoids superfluous
-- textual conflicts that would arise from preferring Bob's names for Bob's code (where his names differ).
--
-- The LCA names are not used unless we need to render LCA definitions for a mergetool, but we add them to the PPE in
-- all cases anyway. If this is very expensive, we could consider omitting them in the case that no mergetool is
-- configured.
--
-- Note that LCA names can make name quality slightly worse. For example, "foo.bar" might exist in the LCA, but deleted
-- in Alice and Bob, and nonetheless prevent some "qux.bar" from rendering as "bar". That seems fine.
makePrettyPrintEnv :: ThreeWay Names -> Names -> Names -> PrettyPrintEnvDecl
makePrettyPrintEnv :: ThreeWay Names -> Names -> Names -> PrettyPrintEnvDecl
makePrettyPrintEnv ThreeWay Names
names Names
libdepsNames Names
lcaLibdeps =
  Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
    ( Names -> Namer
PPE.namer
        ( Names -> Names -> Names
Names.preferring
            -- Here it might be slightly more comfortable to Alice if we prefer her names and _her_ libdeps, not the
            -- combined Alice+Bob libdep, because that might bring in a Bob name that Alice isn't yet familiar with
            -- (even though it will be in her merge result at the end). However, that would require a bit of simple
            -- refactoring (just need to delay the combining of libdeps until at least here), and doesn't seem worth it
            -- over this quick fix of just "prefer Alice + any libdep name over names that only Bob's project has".
            (Names -> Names -> Names
Names.preferring (ThreeWay Names
names.alice Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
libdepsNames) ThreeWay Names
names.bob)
            (ThreeWay Names
names.lca Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
lcaLibdeps)
        )
    )
    (Names -> Suffixifier
PPE.suffixifyByName (ThreeWay Names -> Names
forall m. Monoid m => ThreeWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ThreeWay Names
names Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
libdepsNames))

makePrettyUnisonFile ::
  TwoWay Text ->
  TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) ->
  TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) ->
  Pretty ColorText
makePrettyUnisonFile :: TwoWay Text
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettyUnisonFile TwoWay Text
authors TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
conflicts TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents =
  [Pretty ColorText] -> Pretty ColorText
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
conflicts
        -- Merge the two maps together into one, remembering who authored what
        TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
    -> Defns
         (Map Name (These (Pretty ColorText) (Pretty ColorText)))
         (Map Name (These (Pretty ColorText) (Pretty ColorText))))
-> Defns
     (Map Name (These (Pretty ColorText) (Pretty ColorText)))
     (Map Name (These (Pretty ColorText) (Pretty ColorText)))
forall a b. a -> (a -> b) -> b
& (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
 -> Defns
      (Map Name (These (Pretty ColorText) (Pretty ColorText)))
      (Map Name (These (Pretty ColorText) (Pretty ColorText))))
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Defns
     (Map Name (These (Pretty ColorText) (Pretty ColorText)))
     (Map Name (These (Pretty ColorText) (Pretty ColorText)))
forall a b. (a -> a -> b) -> TwoWay a -> b
TwoWay.twoWay ((Map Name (Pretty ColorText)
 -> Map Name (Pretty ColorText)
 -> Map Name (These (Pretty ColorText) (Pretty ColorText)))
-> (Map Name (Pretty ColorText)
    -> Map Name (Pretty ColorText)
    -> Map Name (These (Pretty ColorText) (Pretty ColorText)))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Defns
     (Map Name (These (Pretty ColorText) (Pretty ColorText)))
     (Map Name (These (Pretty ColorText) (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 (These (Pretty ColorText) (Pretty ColorText))
forall a b. Map Name a -> Map Name b -> Map Name (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Map Name (Pretty ColorText)
-> Map Name (Pretty ColorText)
-> Map Name (These (Pretty ColorText) (Pretty ColorText))
forall a b. Map Name a -> Map Name b -> Map Name (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align)
        -- Sort alphabetically
        Defns
  (Map Name (These (Pretty ColorText) (Pretty ColorText)))
  (Map Name (These (Pretty ColorText) (Pretty ColorText)))
-> (Defns
      (Map Name (These (Pretty ColorText) (Pretty ColorText)))
      (Map Name (These (Pretty ColorText) (Pretty ColorText)))
    -> DefnsF
         []
         (These (Pretty ColorText) (Pretty ColorText))
         (These (Pretty ColorText) (Pretty ColorText)))
-> DefnsF
     []
     (These (Pretty ColorText) (Pretty ColorText))
     (These (Pretty ColorText) (Pretty ColorText))
forall a b. a -> (a -> b) -> b
& Defns
  (Map Name (These (Pretty ColorText) (Pretty ColorText)))
  (Map Name (These (Pretty ColorText) (Pretty ColorText)))
-> DefnsF
     []
     (These (Pretty ColorText) (Pretty ColorText))
     (These (Pretty ColorText) (Pretty ColorText))
forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder
        -- Render each conflict, types then terms (even though a type can conflict with a term, in which case they
        -- would not be adjacent in the file), with an author comment above each conflicted thing
        DefnsF
  []
  (These (Pretty ColorText) (Pretty ColorText))
  (These (Pretty ColorText) (Pretty ColorText))
-> (DefnsF
      []
      (These (Pretty ColorText) (Pretty ColorText))
      (These (Pretty ColorText) (Pretty ColorText))
    -> Pretty ColorText)
-> Pretty ColorText
forall a b. a -> (a -> b) -> b
& ( let f :: [These (Pretty ColorText) (Pretty ColorText)] -> Pretty ColorText
f =
                  (These (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText)
-> [These (Pretty ColorText) (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 \case
                    This Pretty ColorText
x -> Pretty ColorText -> Pretty ColorText
alice Pretty ColorText
x
                    That Pretty ColorText
y -> Pretty ColorText -> Pretty ColorText
bob Pretty ColorText
y
                    These Pretty ColorText
x Pretty ColorText
y -> Pretty ColorText -> Pretty ColorText
alice Pretty ColorText
x Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
bob Pretty ColorText
y
                  where
                    alice :: Pretty ColorText -> Pretty ColorText
alice = Maybe (Pretty ColorText) -> Pretty ColorText -> Pretty ColorText
forall {m}. (Monoid m, IsString m) => Maybe m -> m -> m
prettyBinding (Pretty ColorText -> Maybe (Pretty ColorText)
forall a. a -> Maybe a
Just (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text TwoWay Text
authors.alice))
                    bob :: Pretty ColorText -> Pretty ColorText
bob = Maybe (Pretty ColorText) -> Pretty ColorText -> Pretty ColorText
forall {m}. (Monoid m, IsString m) => Maybe m -> m -> m
prettyBinding (Pretty ColorText -> Maybe (Pretty ColorText)
forall a. a -> Maybe a
Just (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text TwoWay Text
authors.bob))
             in ([These (Pretty ColorText) (Pretty ColorText)] -> Pretty ColorText)
-> ([These (Pretty ColorText) (Pretty ColorText)]
    -> Pretty ColorText)
-> DefnsF
     []
     (These (Pretty ColorText) (Pretty ColorText))
     (These (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
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 [These (Pretty ColorText) (Pretty ColorText)] -> Pretty ColorText
f [These (Pretty ColorText) (Pretty ColorText)] -> Pretty ColorText
f
          ),
      -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and
      -- dependents
      let thereAre :: TwoWay (Defns (f a) (g b)) -> Bool
thereAre TwoWay (Defns (f a) (g b))
defns = TwoWay Bool -> Bool
TwoWay.or (Bool -> Bool
not (Bool -> Bool)
-> (Defns (f a) (g b) -> Bool) -> Defns (f a) (g b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defns (f a) (g b) -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty (Defns (f a) (g b) -> Bool)
-> TwoWay (Defns (f a) (g b)) -> TwoWay Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (f a) (g b))
defns)
       in if TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Bool
forall {f :: * -> *} {g :: * -> *} {a} {b}.
(Foldable f, Foldable g) =>
TwoWay (Defns (f a) (g b)) -> Bool
thereAre TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
conflicts Bool -> Bool -> Bool
&& TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Bool
forall {f :: * -> *} {g :: * -> *} {a} {b}.
(Foldable f, Foldable g) =>
TwoWay (Defns (f a) (g b)) -> Bool
thereAre TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents
            then
              [Pretty ColorText] -> Pretty ColorText
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                [ Pretty ColorText
"-- The definitions below are not conflicted, but they each depend on one or more\n",
                  Pretty ColorText
"-- conflicted definitions above.\n\n"
                ]
            else Pretty ColorText
forall a. Monoid a => a
mempty,
      TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettyDependents TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents
    ]
  where
    prettyBinding :: Maybe m -> m -> m
prettyBinding Maybe m
maybeComment m
binding =
      [m] -> m
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ case Maybe m
maybeComment of
            Maybe m
Nothing -> m
forall a. Monoid a => a
mempty
            Just m
comment -> m
"-- " m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
comment m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
"\n",
          m
binding,
          m
"\n\n"
        ]

makePrettySoloUnisonFile ::
  DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) ->
  TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) ->
  Pretty ColorText
makePrettySoloUnisonFile :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettySoloUnisonFile DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
conflicts TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents =
  [Pretty ColorText] -> Pretty ColorText
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
conflicts
        DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
    -> DefnsF [] (Pretty ColorText) (Pretty ColorText))
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
forall a b. a -> (a -> b) -> b
& DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder
        DefnsF [] (Pretty ColorText) (Pretty ColorText)
-> (DefnsF [] (Pretty ColorText) (Pretty ColorText)
    -> Pretty ColorText)
-> Pretty ColorText
forall a b. a -> (a -> b) -> b
& let f :: [Pretty ColorText] -> Pretty ColorText
f = (Pretty ColorText -> Pretty ColorText)
-> [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 (Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n") in ([Pretty ColorText] -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
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 [Pretty ColorText] -> Pretty ColorText
f [Pretty ColorText] -> Pretty ColorText
f,
      -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and
      -- dependents
      if Bool -> Bool
not (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
conflicts) Bool -> Bool -> Bool
&& TwoWay Bool -> Bool
TwoWay.or (Bool -> Bool
not (Bool -> Bool)
-> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
    -> Bool)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Bool)
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> TwoWay Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents)
        then
          [Pretty ColorText] -> Pretty ColorText
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            [ Pretty ColorText
"-- The definitions below are not conflicted, but they each depend on one or more\n",
              Pretty ColorText
"-- conflicted definitions.\n\n"
            ]
        else Pretty ColorText
forall a. Monoid a => a
mempty,
      -- Include all dependents when invoking this function with alice/bob/lca conflicts, because we don't want any diff
      -- here – we want the mergetool to copy over all dependents after resolving the real conflicts above the fold.
      TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettyDependents TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
dependents
    ]

makePrettyDependents :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> Pretty ColorText
makePrettyDependents :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
makePrettyDependents =
  -- Merge dependents together into one map (they are disjoint)
  (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall a b. (a -> a -> b) -> TwoWay a -> b
TwoWay.twoWay ((Map Name (Pretty ColorText)
 -> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText))
-> (Map Name (Pretty ColorText)
    -> Map Name (Pretty ColorText) -> Map Name (Pretty ColorText))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF (Map Name) (Pretty ColorText) (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)
    (TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
    -> Pretty ColorText)
-> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> Pretty ColorText
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    -- Sort alphabetically
    DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder
    -- Render each dependent, types then terms, without bothering to comment attribution
    (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
 -> DefnsF [] (Pretty ColorText) (Pretty ColorText))
-> (DefnsF [] (Pretty ColorText) (Pretty ColorText)
    -> Pretty ColorText)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (let f :: [Pretty ColorText] -> Pretty ColorText
f = (Pretty ColorText -> Pretty ColorText)
-> [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 (Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n") in ([Pretty ColorText] -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
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 [Pretty ColorText] -> Pretty ColorText
f [Pretty ColorText] -> Pretty ColorText
f)

inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder :: forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder =
  (Map Name a -> [a])
-> (Map Name b -> [b])
-> Defns (Map Name a) (Map Name b)
-> Defns [a] [b]
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 a -> [a]
forall {b}. Map Name b -> [b]
f Map Name b -> [b]
forall {b}. Map Name b -> [b]
f
  where
    f :: Map Name b -> [b]
f = ((Name, b) -> b) -> [(Name, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Name, b) -> b
forall a b. (a, b) -> b
snd ([(Name, b)] -> [b])
-> (Map Name b -> [(Name, b)]) -> Map Name b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, b) -> Text) -> [(Name, b)] -> [(Name, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Name -> Text
Name.toText (Name -> Text) -> ((Name, b) -> Name) -> (Name, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> Name
forall a b. (a, b) -> a
fst) ([(Name, b)] -> [(Name, b)])
-> (Map Name b -> [(Name, b)]) -> Map Name b -> [(Name, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name b -> [(Name, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

-- Given Alice's and Bob's hydrated defns, make a mapping from unique type name to unique type GUID, preferring Alice's
-- GUID if they both have one.
makeUniqueTypeGuids ::
  TwoWay
    ( DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TypeReferenceId, Decl Symbol Ann)
    ) ->
  Map Name Text
makeUniqueTypeGuids :: TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> Map Name Text
makeUniqueTypeGuids TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns =
  let -- Start off with just Alice's GUIDs
      aliceGuids :: Map Name Text
      aliceGuids :: Map Name Text
aliceGuids =
        ((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
declGuid (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) TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns.alice.types

      -- Define a helper that adds a Bob GUID only if it's not already in the map (so, preferring Alice)
      addBobGuid :: Map Name Text -> (Name, (TypeReferenceId, Decl Symbol Ann)) -> Map Name Text
      addBobGuid :: Map Name Text
-> (Name, (TermReferenceId, Decl Symbol Ann)) -> Map Name Text
addBobGuid Map Name Text
acc (Name
name, (TermReferenceId
_, Decl Symbol Ann
bobDecl)) =
        (Maybe Text -> Maybe Text)
-> Name -> Map Name Text -> Map Name Text
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
          ( \case
              Maybe Text
Nothing -> Maybe Text
bobGuid
              Just Text
aliceGuid -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
aliceGuid
          )
          Name
name
          Map Name Text
acc
        where
          bobGuid :: Maybe Text
          bobGuid :: Maybe Text
bobGuid =
            Decl Symbol Ann -> Maybe Text
forall v a. Decl v a -> Maybe Text
declGuid Decl Symbol Ann
bobDecl

      -- Tumble in all of Bob's GUIDs with that helper
      allTheGuids :: Map Name Text
      allTheGuids :: Map Name Text
allTheGuids =
        (Map Name Text
 -> (Name, (TermReferenceId, Decl Symbol Ann)) -> Map Name Text)
-> Map Name Text
-> [(Name, (TermReferenceId, Decl Symbol Ann))]
-> Map Name Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map Name Text
-> (Name, (TermReferenceId, Decl Symbol Ann)) -> Map Name Text
addBobGuid Map Name Text
aliceGuids (Map Name (TermReferenceId, Decl Symbol Ann)
-> [(Name, (TermReferenceId, Decl Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList TwoWay
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
hydratedDefns.bob.types)
   in Map Name Text
allTheGuids
  where
    declGuid :: Decl v a -> Maybe Text
    declGuid :: forall v a. Decl v a -> Maybe Text
declGuid Decl v a
decl =
      case (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
DataDeclaration.asDataDecl Decl v a
decl).modifier of
        Modifier
DataDeclaration.Structural -> Maybe Text
forall a. Maybe a
Nothing
        DataDeclaration.Unique Text
guid -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
guid