module Unison.Merge.Render
  ( renderUnisonFiles,
  )
where

import Control.Lens (mapped)
import Data.Align (align)
import Data.Bifoldable (bifoldMap)
import Data.List qualified as List
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.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 (..))
import Unison.Merge.ThreeWay (GThreeWay, ThreeWay (..))
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.TwoWay qualified as TwoWay
import Unison.Merge.Updated (GUpdated (..), Updated)
import Unison.Name (Name)
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.PartialDeclNameLookup (PartialDeclNameLookup (..))
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference (TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Referent (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.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith)
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Prelude hiding (unzip)

renderUnisonFiles ::
  TwoWay Text ->
  GThreeWay PartialDeclNameLookup DeclNameLookup ->
  ThreeWay (DefnsF (Map Name) Referent TypeReference) ->
  ThreeWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) ->
  Updated Names ->
  TwoWay (DefnsF Set Name Name) ->
  TwoWay (DefnsF Set Name Name) ->
  (Pretty ColorText, ThreeWay (Pretty ColorText))
renderUnisonFiles :: TwoWay Text
-> GThreeWay PartialDeclNameLookup DeclNameLookup
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> ThreeWay
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)))
-> Updated Names
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> (Pretty ColorText, ThreeWay (Pretty ColorText))
renderUnisonFiles TwoWay Text
authors GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName ThreeWay
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
hydratedDefns Updated Names
libdepsNames TwoWay (Defns (Set Name) (Set Name))
conflicts TwoWay (Defns (Set Name) (Set Name))
dependents =
  let pped :: PrettyPrintEnvDecl
      pped :: PrettyPrintEnvDecl
pped =
        ThreeWay Names -> Updated Names -> PrettyPrintEnvDecl
makePrettyPrintEnv
          (DefnsF (Map Name) Referent TypeReference -> Names
Names.fromUnconflicted (DefnsF (Map Name) Referent TypeReference -> Names)
-> ThreeWay (DefnsF (Map Name) Referent TypeReference)
-> ThreeWay Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreeWay (DefnsF (Map Name) Referent TypeReference)
defnsByName)
          Updated Names
libdepsNames

      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
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (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
          (GThreeWay PartialDeclNameLookup DeclNameLookup
-> TwoWay DeclNameLookup
forall a b. GThreeWay a b -> TwoWay b
ThreeWay.gforgetLca GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups)
          (ThreeWay
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
-> TwoWay
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
hydratedDefns)
          TwoWay (Defns (Set Name) (Set Name))
conflicts
          TwoWay (Defns (Set Name) (Set Name))
dependents
          PrettyPrintEnvDecl
pped

      renderedLcaConflicts :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
      renderedLcaConflicts :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderedLcaConflicts =
        PartialDeclNameLookup
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts
          GThreeWay PartialDeclNameLookup DeclNameLookup
declNameLookups.lca
          ThreeWay
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
hydratedDefns.lca
          TwoWay (Defns (Set Name) (Set Name))
conflicts
          PrettyPrintEnvDecl
pped

      unparsedFile :: Pretty ColorText
      unparsedFile :: 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

      unparsedSoloFiles :: ThreeWay (Pretty ColorText)
      unparsedSoloFiles :: 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
   in (Pretty ColorText
unparsedFile, ThreeWay (Pretty ColorText)
unparsedSoloFiles)

-- 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 -> Updated Names -> PrettyPrintEnvDecl
makePrettyPrintEnv :: ThreeWay Names -> Updated Names -> PrettyPrintEnvDecl
makePrettyPrintEnv ThreeWay Names
defns Updated Names
libdeps =
  Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
    ( Names -> Namer
PPE.namer
        ( Names -> Names -> Names
Names.preferring
            -- Here it might be slightly more comfortable to Alice if we prefer her names and _her_ libdeps, not the
            -- combined Alice+Bob libdep, because that might bring in a Bob name that Alice isn't yet familiar with
            -- (even though it will be in her merge result at the end). However, that would require a bit of simple
            -- refactoring (just need to delay the combining of libdeps until at least here), and doesn't seem worth it
            -- over this quick fix of just "prefer Alice + any libdep name over names that only Bob's project has".
            (Names -> Names -> Names
Names.preferring (ThreeWay Names
defns.alice Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Updated Names
libdeps.new) ThreeWay Names
defns.bob)
            (ThreeWay Names
defns.lca Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Updated Names
libdeps.old)
        )
    )
    (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
defns Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Updated Names
libdeps.new))

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
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (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
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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 (Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
conflicts, Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
dependents) ->
        let render :: Set Name
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
needsGuid = DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall a v.
(Var v, Monoid a) =>
DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderDefnsForUnisonFile DeclNameLookup
declNameLookup PrettyPrintEnvDecl
ppe Set Name
needsGuid (DefnsF
   (Map Name)
   (Term Symbol Ann, Type Symbol Ann)
   (TermReferenceId, Decl Symbol Ann)
 -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText))
-> (Defns
      (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
      (Map Name (TermReferenceId, Decl Symbol Ann))
    -> DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TermReferenceId, Decl Symbol Ann))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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)))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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)))
 -> Defns
      (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
      (Map Name (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
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)))
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Identity (Map Name (Term Symbol Ann, Type Symbol Ann))
Setter
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (Term Symbol Ann, Type Symbol Ann)
forall a b. (a, b) -> b
snd
         in (Set Name
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
uniqueTypeConflictsWithDifferentGuids Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
conflicts, Set Name
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
render Set Name
forall a. Set a
Set.empty Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
dependents)
    )
      (DeclNameLookup
 -> (Defns
       (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
       (Map Name (TermReferenceId, Decl Symbol Ann)),
     Defns
       (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
       (Map Name (TermReferenceId, Decl Symbol Ann)))
 -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
     DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
-> TwoWay DeclNameLookup
-> TwoWay
     ((Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (TermReferenceId, Decl Symbol Ann)),
       Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (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
  ((Defns
      (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
      (Map Name (TermReferenceId, Decl Symbol Ann)),
    Defns
      (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
      (Map Name (TermReferenceId, Decl Symbol Ann)))
   -> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText),
       DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)))
-> TwoWay
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)),
      Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (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
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)),
   Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)),
   Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
hydratedConflictsAndDependents =
      ( \Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (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))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> Defns (Set Name) (Set Name)
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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 Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (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))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> Defns (Set Name) (Set Name)
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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 Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
as Defns (Set Name) (Set Name)
cs
          )
      )
        (Defns
   (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
   (Map Name (TermReferenceId, Decl Symbol Ann))
 -> Defns (Set Name) (Set Name)
 -> Defns (Set Name) (Set Name)
 -> (Defns
       (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
       (Map Name (TermReferenceId, Decl Symbol Ann)),
     Defns
       (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
       (Map Name (TermReferenceId, Decl Symbol Ann))))
-> TwoWay
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)))
-> TwoWay
     (Defns (Set Name) (Set Name)
      -> Defns (Set Name) (Set Name)
      -> (Defns
            (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
            (Map Name (TermReferenceId, Decl Symbol Ann)),
          Defns
            (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
            (Map Name (TermReferenceId, Decl Symbol Ann))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann)))
hydratedDefns
        TwoWay
  (Defns (Set Name) (Set Name)
   -> Defns (Set Name) (Set Name)
   -> (Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (TermReferenceId, Decl Symbol Ann)),
       Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (TermReferenceId, Decl Symbol Ann))))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
     (Defns (Set Name) (Set Name)
      -> (Defns
            (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
            (Map Name (TermReferenceId, Decl Symbol Ann)),
          Defns
            (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
            (Map Name (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)
   -> (Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (TermReferenceId, Decl Symbol Ann)),
       Defns
         (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
         (Map Name (TermReferenceId, Decl Symbol Ann))))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)),
      Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (TermReferenceId, Decl Symbol Ann)))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (Defns (Set Name) (Set Name))
dependents

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

renderLcaConflicts ::
  PartialDeclNameLookup ->
  DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) ->
  TwoWay (DefnsF Set Name Name) ->
  PrettyPrintEnvDecl ->
  DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts :: PartialDeclNameLookup
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> TwoWay (Defns (Set Name) (Set Name))
-> PrettyPrintEnvDecl
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderLcaConflicts PartialDeclNameLookup
partialDeclNameLookup Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
hydratedDefns TwoWay (Defns (Set Name) (Set Name))
conflicts PrettyPrintEnvDecl
ppe =
  let hydratedConflicts :: Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (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))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (TermReferenceId, Decl Symbol Ann))
-> Defns (Set Name) (Set Name)
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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 Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (TermReferenceId, Decl Symbol Ann))
hydratedDefns (TwoWay (Defns (Set Name) (Set Name)) -> Defns (Set Name) (Set Name)
forall m. Monoid m => TwoWay m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold TwoWay (Defns (Set Name) (Set Name))
conflicts)
   in DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall a v.
(Var v, Monoid a) =>
DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderDefnsForUnisonFile
        DeclNameLookup
declNameLookup
        PrettyPrintEnvDecl
ppe
        Set Name
forall a. Set a
Set.empty
        (ASetter
  (Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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)))
-> Defns
     (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
     (Map Name (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)))
 -> Defns
      (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
      (Map Name (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
     (Defns
        (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
        (Map Name (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 Defns
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (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))

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