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.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.PrettyPrintEnv (makePrettyPrintEnvs)
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.Parser.Ann (Ann)
import Unison.Prelude
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,
    Mergeblob3 -> Pretty ColorText
unparsedFile :: Pretty ColorText
  }

makeMergeblob3 ::
  Mergeblob2 libdep ->
  TwoWay (DefnsF Set TermReferenceId TypeReferenceId) ->
  Names ->
  TwoWay Text ->
  Mergeblob3
makeMergeblob3 :: forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> Names
-> TwoWay Text
-> Mergeblob3
makeMergeblob3 Mergeblob2 libdep
blob TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependents0 Names
libdeps TwoWay Text
authors =
  let conflictsNames :: TwoWay (DefnsF Set Name Name)
      conflictsNames :: TwoWay (DefnsF Set Name Name)
conflictsNames =
        (Map Name TermReferenceId -> Set Name)
-> (Map Name TermReferenceId -> Set Name)
-> Defns (Map Name TermReferenceId) (Map Name TermReferenceId)
-> DefnsF Set Name Name
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name TermReferenceId -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name TermReferenceId -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (Defns (Map Name TermReferenceId) (Map Name TermReferenceId)
 -> DefnsF Set Name Name)
-> TwoWay
     (Defns (Map Name TermReferenceId) (Map Name TermReferenceId))
-> TwoWay (DefnsF Set Name 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 (DefnsF Set Name Name)
dependents =
        TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name 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 (DefnsF Set Name 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
-> DefnsF Set Name Name
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith
                  (\BiMultimap Referent Name
defns Set TermReferenceId
deps -> (Referent -> NESet Name -> Set Name)
-> Map Referent (NESet Name) -> Set Name
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (Set TermReferenceId -> Referent -> NESet Name -> Set Name
f Set TermReferenceId
deps) (BiMultimap Referent Name -> Map Referent (NESet Name)
forall a b. BiMultimap a b -> Map a (NESet b)
BiMultimap.domain BiMultimap Referent Name
defns))
                  (\BiMultimap 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
 -> DefnsF Set Name Name)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay
     (DefnsF Set TermReferenceId TermReferenceId
      -> DefnsF Set Name 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
   -> DefnsF Set Name Name)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set Name Name)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
dependents0
          )

      (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 (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
-> TwoWay Names
-> Names
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
    TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
renderConflictsAndDependents
          Mergeblob2 libdep
blob.declNameLookups
          Mergeblob2 libdep
blob.hydratedDefns
          TwoWay (DefnsF Set Name Name)
conflictsNames
          TwoWay (DefnsF Set Name Name)
dependents
          (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Names
defnsToNames (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
 -> Names)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay Names
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)
          Names
libdeps
   in Mergeblob3
        { Names
$sel:libdeps:Mergeblob3 :: Names
libdeps :: Names
libdeps,
          $sel:stageOne:Mergeblob3 :: DefnsF (Map Name) Referent TypeReference
stageOne =
            TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts Referent TypeReference
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF (Map Name) Referent TypeReference
forall term typ.
TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts term typ
-> TwoWay (DefnsF Set Name Name)
-> DefnsF (Map Name) term typ
-> DefnsF (Map Name) term typ
makeStageOne
              Mergeblob2 libdep
blob.declNameLookups
              TwoWay (DefnsF Set Name Name)
conflictsNames
              Mergeblob2 libdep
blob.unconflicts
              TwoWay (DefnsF Set Name 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 Mergeblob2 libdep
blob.hydratedDefns,
          $sel:stageTwo:Mergeblob3 :: DefnsF (Map Name) Referent TypeReference
stageTwo =
            TwoWay DeclNameLookup
-> TwoWay (DefnsF Set Name Name)
-> DefnsF Unconflicts Referent TypeReference
-> TwoWay (DefnsF Set Name Name)
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> DefnsF (Map Name) Referent TypeReference
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
              Mergeblob2 libdep
blob.declNameLookups
              TwoWay (DefnsF Set Name Name)
conflictsNames
              Mergeblob2 libdep
blob.unconflicts
              TwoWay (DefnsF Set Name 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
        }

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

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

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 (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 TwoWay DeclNameLookup
declNameLookups TwoWay (DefnsF Set Name Name)
conflicts DefnsF Unconflicts term typ
unconflicts TwoWay (DefnsF Set Name 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
-> DefnsF Set Name 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 (DefnsF Set Name 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 (DefnsF Set Name 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
-> DefnsF Set Name 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
 -> DefnsF Set Name Name -> DefnsF (Map Name) term typ)
-> TwoWay (DefnsF (Map Name) term typ)
-> TwoWay (DefnsF Set Name 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 (DefnsF Set Name Name -> DefnsF (Map Name) term typ)
-> TwoWay (DefnsF Set Name 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 (DefnsF Set Name 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 -> DefnsF Set Name Name -> DefnsF Set Name Name
refIdsToNames DeclNameLookup
declNameLookup =
  (Set Name -> DefnsF Set Name Name)
-> (Set Name -> DefnsF Set Name Name)
-> DefnsF Set Name Name
-> DefnsF Set Name Name
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap Set Name -> DefnsF Set Name Name
goTerms Set Name -> DefnsF Set Name Name
goTypes
  where
    goTerms :: Set Name -> DefnsF Set Name Name
    goTerms :: Set Name -> DefnsF Set Name Name
goTerms Set Name
terms =
      Defns {Set Name
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 -> DefnsF Set Name Name
goTypes Set Name
types =
      Defns
        { $sel:terms:Defns :: Set Name
terms = (Name -> Set Name) -> Set Name -> Set Name
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> (Name -> [Name]) -> Name -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
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) ->
  TwoWay Names ->
  Names ->
  ( 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 (DefnsF Set Name Name)
-> TwoWay (DefnsF Set Name Name)
-> TwoWay Names
-> Names
-> (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 (DefnsF Set Name Name)
conflicts TwoWay (DefnsF Set Name Name)
dependents TwoWay Names
names Names
libdepsNames =
  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) PrettyPrintEnvDecl
ppe ->
        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))
 -> PrettyPrintEnvDecl
 -> (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))
      -> PrettyPrintEnvDecl
      -> (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))
   -> PrettyPrintEnvDecl
   -> (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
     (PrettyPrintEnvDecl
      -> (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
      TwoWay
  (PrettyPrintEnvDecl
   -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
       DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
-> TwoWay PrettyPrintEnvDecl
-> 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 Names -> Names -> TwoWay PrettyPrintEnvDecl
makePrettyPrintEnvs TwoWay Names
names Names
libdepsNames
  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 DefnsF Set Name Name
bs DefnsF Set Name 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)
-> DefnsF Set Name 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 DefnsF Set Name 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)
-> DefnsF Set Name 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 DefnsF Set Name Name
cs
          )
      )
        (DefnsF
   (Map Name)
   (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
   (TermReferenceId, Decl Symbol Ann)
 -> DefnsF Set Name Name
 -> DefnsF Set Name 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
     (DefnsF Set Name Name
      -> DefnsF Set Name 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
  (DefnsF Set Name Name
   -> DefnsF Set Name 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 Set Name Name)
-> TwoWay
     (DefnsF Set Name 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 (DefnsF Set Name Name)
conflicts
        TwoWay
  (DefnsF Set Name 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 Set Name 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 (DefnsF Set Name Name)
dependents

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))
dependents
        -- Merge dependents together into one map (they are disjoint)
        TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (TwoWay
      (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
    -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> DefnsF (Map Name) (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)
 -> 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)
        -- Sort alphabetically
        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
        -- Render each dependent, types then terms, without bothering to comment attribution
        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 (Maybe (Pretty ColorText) -> Pretty ColorText -> Pretty ColorText
forall {m}. (Monoid m, IsString m) => Maybe m -> m -> m
prettyBinding Maybe (Pretty ColorText)
forall a. Maybe a
Nothing) 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)
    ]
  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",
          m
"\n"
        ]

    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