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

import Control.Lens (mapped)
import Data.Align (align)
import Data.Bifoldable (bifoldMap)
import Data.List qualified as List
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.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 (BiMultimap)
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 Unison.Util.Relation qualified as Relation
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)
dependents0 Names
libdeps Names
lcaLibdeps TwoWay Text
authors =
  let 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

      -- Identify 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))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
forall name.
Ord name =>
TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
filterDependents
          TwoWay (Defns (Set Name) (Set Name))
conflictsNames
          Mergeblob2 libdep
blob.soloUpdatesAndDeletes
          ( let 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
             in (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)
dependents0
          )

      ppe :: PrettyPrintEnvDecl
      ppe :: PrettyPrintEnvDecl
ppe =
        ThreeWay Names -> Names -> Names -> PrettyPrintEnvDecl
makePrettyPrintEnv
          (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Names
defnsToNames (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> Names)
-> ThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> ThreeWay Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mergeblob2 libdep
blob.defns)
          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
              ((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 Mergeblob2 libdep
blob.defns.lca),
          $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: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
              ((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),
          $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
        }

filterDependents ::
  (Ord name) =>
  TwoWay (DefnsF Set name name) ->
  TwoWay (DefnsF Set name name) ->
  TwoWay (DefnsF Set name name) ->
  TwoWay (DefnsF Set name name)
filterDependents :: forall name.
Ord name =>
TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
-> TwoWay (DefnsF Set name name)
filterDependents TwoWay (Defns (Set name) (Set name))
conflicts TwoWay (Defns (Set name) (Set name))
soloUpdatesAndDeletes TwoWay (Defns (Set name) (Set name))
dependents0 =
  -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put
  -- into the scratch file: those for which any of the following are true:
  --
  --   1. It is Alice-conflicted (since we only want to return *unconflicted* things).
  --   2. It was deleted by Bob.
  --   3. It was updated by Bob and not updated by Alice.
  let dependents1 :: TwoWay (Defns (Set name) (Set name))
dependents1 =
        (Set name -> Set name -> Set name)
-> (Set name -> Set name -> Set name)
-> Defns (Set name) (Set name)
-> Defns (Set name) (Set name)
-> 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 Set name -> Set name -> Set name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set name -> Set name -> Set name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
          (Defns (Set name) (Set name)
 -> Defns (Set name) (Set name) -> Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
-> TwoWay
     (Defns (Set name) (Set name) -> Defns (Set name) (Set name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Set name) (Set name))
dependents0
          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))
conflicts TwoWay (Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
forall a. Semigroup a => a -> a -> a
<> TwoWay (Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
forall a. TwoWay a -> TwoWay a
TwoWay.swap TwoWay (Defns (Set name) (Set name))
soloUpdatesAndDeletes)

      -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key
      -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)...
      --
      --   { alice = { terms = {"foo" => #alice} } }
      --   { bob   = { terms = {"foo" => #alice} } }
      --
      -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)...
      --
      --   { alice = { terms = {"foo" => #alice} } }
      --   { bob   = { terms = {"foo" => #bob}   } }
      --
      -- So, we can arbitrarily keep Alice's, because they will render the same.
      --
      --   { alice = { terms = {"foo" => #alice} } }
      --   { bob   = { terms = {}                } }
      dependents2 :: TwoWay (Defns (Set name) (Set name))
dependents2 =
        TwoWay (Defns (Set name) (Set name))
dependents1 TwoWay (Defns (Set name) (Set name))
-> (TwoWay (Defns (Set name) (Set name))
    -> TwoWay (Defns (Set name) (Set name)))
-> TwoWay (Defns (Set name) (Set name))
forall a b. a -> (a -> b) -> b
& ASetter
  (TwoWay (Defns (Set name) (Set name)))
  (TwoWay (Defns (Set name) (Set name)))
  (Defns (Set name) (Set name))
  (Defns (Set name) (Set name))
-> (Defns (Set name) (Set name) -> Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
-> TwoWay (Defns (Set name) (Set name))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (TwoWay (Defns (Set name) (Set name)))
  (TwoWay (Defns (Set name) (Set name)))
  (Defns (Set name) (Set name))
  (Defns (Set name) (Set name))
#bob \Defns (Set name) (Set name)
bob ->
          (Set name -> Set name -> Set name)
-> (Set name -> Set name -> Set name)
-> Defns (Set name) (Set name)
-> Defns (Set name) (Set name)
-> 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 Set name -> Set name -> Set name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set name -> Set name -> Set name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Defns (Set name) (Set name)
bob TwoWay (Defns (Set name) (Set name))
dependents1.alice
   in TwoWay (Defns (Set name) (Set name))
dependents2

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
lca 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
conflicts (Unconflicts v -> Map Name v -> Map Name v
forall v. Unconflicts v -> Map Name v -> Map Name v
Unconflicts.apply Unconflicts v
unconflicts ((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
lca))

-- 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 :: DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render = DeclNameLookup
-> PrettyPrintEnvDecl
-> 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
-> 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 (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 (DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render 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)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render 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

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
-> 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
-> 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 (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
            (Names -> Names -> Names
Names.preferring ThreeWay Names
names.alice ThreeWay Names
names.bob Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
libdepsNames)
            (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))

defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names
defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Names
defnsToNames Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns =
  Names
    { $sel:terms:Names :: Relation Name Referent
terms = Map Name Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap (BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns.terms),
      $sel:types:Names :: Relation Name TypeReference
types = Map Name TypeReference -> Relation Name TypeReference
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap (BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns.types)
    }

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