module Unison.Merge.Mergeblob2
( Mergeblob2 (..),
Mergeblob2Error (..),
makeMergeblob2,
)
where
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.Merge.EitherWay (EitherWay (..))
import Unison.Merge.FindConflictedAlias (findConflictedAlias)
import Unison.Merge.Mergeblob1 (Mergeblob1 (..))
import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup)
import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins)
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.NameSegment (NameSegment)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defn (Defn)
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith4)
data Mergeblob2 libdep = Mergeblob2
{ forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId),
forall libdep.
Mergeblob2 libdep
-> TwoWay (DefnsF Set TermReference TermReference)
coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference),
forall libdep. Mergeblob2 libdep -> TwoWay DeclNameLookup
declNameLookups :: TwoWay DeclNameLookup,
forall libdep.
Mergeblob2 libdep
-> ThreeWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)),
forall libdep. Mergeblob2 libdep -> Bool
hasConflicts :: Bool,
forall libdep.
Mergeblob2 libdep
-> ThreeWay
(DefnsF
(Map Name)
(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
(TermReferenceId, Decl Symbol Ann))
hydratedDefns ::
ThreeWay
( DefnsF
(Map Name)
(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
(TypeReferenceId, Decl Symbol Ann)
),
forall libdep. Mergeblob2 libdep -> PartialDeclNameLookup
lcaDeclNameLookup :: PartialDeclNameLookup,
forall libdep. Mergeblob2 libdep -> Map NameSegment libdep
lcaLibdeps :: Map NameSegment libdep,
forall libdep. Mergeblob2 libdep -> Map NameSegment libdep
libdeps :: Map NameSegment libdep,
forall libdep.
Mergeblob2 libdep -> DefnsF Unconflicts Referent TermReference
unconflicts :: DefnsF Unconflicts Referent TypeReference
}
data Mergeblob2Error
= Mergeblob2Error'ConflictedAlias (EitherWay (Defn (Name, Name) (Name, Name)))
| Mergeblob2Error'ConflictedBuiltin (Defn Name Name)
makeMergeblob2 :: Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep)
makeMergeblob2 :: forall libdep.
Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep)
makeMergeblob2 Mergeblob1 libdep
blob = do
TwoWay
(Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference)
-> ((Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference)
-> Either Mergeblob2Error ())
-> Either Mergeblob2Error ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((,) ((Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference))
-> TwoWay
(Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
-> TwoWay
(DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
-> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
-> TwoWay
(Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
forall a. a -> a -> TwoWay a
TwoWay Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
forall a. a -> EitherWay a
Alice Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
forall a. a -> EitherWay a
Bob TwoWay
(DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference))
-> TwoWay
(DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference)
-> TwoWay
(Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)),
DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mergeblob1 libdep
blob.diffsFromLCA) \(Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
who, DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
diff) ->
Maybe (Defn (Name, Name) (Name, Name))
-> (Defn (Name, Name) (Name, Name) -> Either Mergeblob2Error ())
-> Either Mergeblob2Error ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
-> Maybe (Defn (Name, Name) (Name, Name))
forall name (synhashed :: * -> *) term typ.
(Ord name, forall ref. Eq (synhashed ref), Ord term, Ord typ) =>
Defns (BiMultimap term name) (BiMultimap typ name)
-> DefnsF3 (Map name) DiffOp synhashed term typ
-> Maybe (Defn (name, name) (name, name))
findConflictedAlias Mergeblob1 libdep
blob.defns.lca DefnsF3 (Map Name) DiffOp Synhashed Referent TermReference
diff) ((Defn (Name, Name) (Name, Name) -> Either Mergeblob2Error ())
-> Either Mergeblob2Error ())
-> (Defn (Name, Name) (Name, Name) -> Either Mergeblob2Error ())
-> Either Mergeblob2Error ()
forall a b. (a -> b) -> a -> b
$
Mergeblob2Error -> Either Mergeblob2Error ()
forall a b. a -> Either a b
Left (Mergeblob2Error -> Either Mergeblob2Error ())
-> (Defn (Name, Name) (Name, Name) -> Mergeblob2Error)
-> Defn (Name, Name) (Name, Name)
-> Either Mergeblob2Error ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherWay (Defn (Name, Name) (Name, Name)) -> Mergeblob2Error
Mergeblob2Error'ConflictedAlias (EitherWay (Defn (Name, Name) (Name, Name)) -> Mergeblob2Error)
-> (Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name)))
-> Defn (Name, Name) (Name, Name)
-> Mergeblob2Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn (Name, Name) (Name, Name)
-> EitherWay (Defn (Name, Name) (Name, Name))
who
TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts <- TwoWay (DefnsF (Map Name) TermReference TermReference)
-> Either
(Defn Name Name)
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
narrowConflictsToNonBuiltins Mergeblob1 libdep
blob.conflicts Either
(Defn Name Name)
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> (Either
(Defn Name Name)
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> Either
Mergeblob2Error
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)))
-> Either
Mergeblob2Error
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
forall a b. a -> (a -> b) -> b
& (Defn Name Name -> Mergeblob2Error)
-> Either
(Defn Name Name)
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
-> Either
Mergeblob2Error
(TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId))
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Defn Name Name -> Mergeblob2Error
Mergeblob2Error'ConflictedBuiltin
let coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference)
coreDependencies :: TwoWay (DefnsF Set TermReference TermReference)
coreDependencies =
TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set TermReference TermReference)
identifyCoreDependencies
(ThreeWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca Mergeblob1 libdep
blob.defns)
((Map Name TermReferenceId -> Set TermReferenceId)
-> (Map Name TermReferenceId -> Set TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) (DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts)
Mergeblob1 libdep
blob.unconflicts
pure
Mergeblob2
{ TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
$sel:conflicts:Mergeblob2 :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts,
TwoWay (DefnsF Set TermReference TermReference)
$sel:coreDependencies:Mergeblob2 :: TwoWay (DefnsF Set TermReference TermReference)
coreDependencies :: TwoWay (DefnsF Set TermReference TermReference)
coreDependencies,
$sel:declNameLookups:Mergeblob2 :: TwoWay DeclNameLookup
declNameLookups = Mergeblob1 libdep
blob.declNameLookups,
$sel:defns:Mergeblob2 :: ThreeWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns = Mergeblob1 libdep
blob.defns,
$sel:hasConflicts:Mergeblob2 :: Bool
hasConflicts = Bool -> Bool
not (DefnsF (Map Name) TermReferenceId TermReferenceId -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.alice) Bool -> Bool -> Bool
|| Bool -> Bool
not (DefnsF (Map Name) TermReferenceId TermReferenceId -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty TwoWay (DefnsF (Map Name) TermReferenceId TermReferenceId)
conflicts.bob),
$sel:hydratedDefns:Mergeblob2 :: ThreeWay
(DefnsF
(Map Name)
(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
(TermReferenceId, Decl Symbol Ann))
hydratedDefns = Mergeblob1 libdep
blob.hydratedDefns,
$sel:lcaDeclNameLookup:Mergeblob2 :: PartialDeclNameLookup
lcaDeclNameLookup = Mergeblob1 libdep
blob.lcaDeclNameLookup,
$sel:lcaLibdeps:Mergeblob2 :: Map NameSegment libdep
lcaLibdeps = Mergeblob1 libdep
blob.lcaLibdeps,
$sel:libdeps:Mergeblob2 :: Map NameSegment libdep
libdeps = Mergeblob1 libdep
blob.libdeps,
$sel:unconflicts:Mergeblob2 :: DefnsF Unconflicts Referent TermReference
unconflicts = Mergeblob1 libdep
blob.unconflicts
}
identifyCoreDependencies ::
TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
TwoWay (DefnsF Set TermReferenceId TypeReferenceId) ->
DefnsF Unconflicts Referent TypeReference ->
TwoWay (DefnsF Set TermReference TypeReference)
identifyCoreDependencies :: TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Unconflicts Referent TermReference
-> TwoWay (DefnsF Set TermReference TermReference)
identifyCoreDependencies TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns TwoWay (DefnsF Set TermReferenceId TermReferenceId)
conflicts DefnsF Unconflicts Referent TermReference
unconflicts = do
let soloUpdatedNames :: TwoWay (Defns (Set Name) (Set Name))
soloUpdatedNames = DefnsF Unconflicts Referent TermReference
-> TwoWay (Defns (Set Name) (Set Name))
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (Defns (Set Name) (Set Name))
Unconflicts.soloUpdatedNames DefnsF Unconflicts Referent TermReference
unconflicts
[TwoWay (DefnsF Set TermReference TermReference)]
-> TwoWay (DefnsF Set TermReference TermReference)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[
let f :: (Ord ref) => Set Name -> Set Name -> Set Name -> BiMultimap ref Name -> BiMultimap ref Name
f :: forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f Set Name
myUpdates Set Name
bothUpdates Set Name
theirDeletesAndUpdates =
Set Name -> BiMultimap ref Name -> BiMultimap ref Name
forall a b.
(Ord a, Ord b) =>
Set b -> BiMultimap a b -> BiMultimap a b
BiMultimap.restrictRan ([Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Name
myUpdates, Set Name
bothUpdates, Set Name
theirDeletesAndUpdates])
in Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF Set TermReference TermReference
forall name.
Defns (BiMultimap Referent name) (BiMultimap TermReference name)
-> DefnsF Set TermReference TermReference
defnsReferences
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> DefnsF Set TermReference TermReference)
-> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (DefnsF Set TermReference TermReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Set Name
-> Set Name
-> Set Name
-> BiMultimap Referent Name
-> BiMultimap Referent Name)
-> (Set Name
-> Set Name
-> Set Name
-> BiMultimap TermReference Name
-> BiMultimap TermReference Name)
-> Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
forall tm1 tm2 tm3 tm4 tm5 ty1 ty2 ty3 ty4 ty5.
(tm1 -> tm2 -> tm3 -> tm4 -> tm5)
-> (ty1 -> ty2 -> ty3 -> ty4 -> ty5)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
-> Defns tm5 ty5
zipDefnsWith4 Set Name
-> Set Name
-> Set Name
-> BiMultimap Referent Name
-> BiMultimap Referent Name
forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f Set Name
-> Set Name
-> Set Name
-> BiMultimap TermReference Name
-> BiMultimap TermReference Name
forall ref.
Ord ref =>
Set Name
-> Set Name
-> Set Name
-> BiMultimap ref Name
-> BiMultimap ref Name
f
(Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
(Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Set Name) (Set Name))
soloUpdatedNames
TwoWay
(Defns (Set Name) (Set Name)
-> Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
(Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Defns (Set Name) (Set Name) -> TwoWay (Defns (Set Name) (Set Name))
forall a. a -> TwoWay a
TwoWay.bothWays (DefnsF Unconflicts Referent TermReference
-> Defns (Set Name) (Set Name)
forall term typ.
DefnsF Unconflicts term typ -> Defns (Set Name) (Set Name)
Unconflicts.bothUpdatedNames DefnsF Unconflicts Referent TermReference
unconflicts)
TwoWay
(Defns (Set Name) (Set Name)
-> Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay (Defns (Set Name) (Set Name))
-> TwoWay (Defns (Set Name) (Set Name))
forall a. TwoWay a -> TwoWay a
TwoWay.swap (DefnsF Unconflicts Referent TermReference
-> TwoWay (Defns (Set Name) (Set Name))
forall term typ.
DefnsF Unconflicts term typ -> TwoWay (Defns (Set Name) (Set Name))
Unconflicts.soloDeletedNames DefnsF Unconflicts Referent TermReference
unconflicts 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))
soloUpdatedNames)
TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name)
-> Defns
(BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
-> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay
(Defns (BiMultimap Referent Name) (BiMultimap TermReference Name))
defns
),
(Set TermReferenceId -> Set TermReference)
-> (Set TermReferenceId -> Set TermReference)
-> DefnsF Set TermReferenceId TermReferenceId
-> DefnsF Set TermReference TermReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((TermReferenceId -> TermReference)
-> Set TermReferenceId -> Set TermReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermReferenceId -> TermReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId) ((TermReferenceId -> TermReference)
-> Set TermReferenceId -> Set TermReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermReferenceId -> TermReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId) (DefnsF Set TermReferenceId TermReferenceId
-> DefnsF Set TermReference TermReference)
-> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
-> TwoWay (DefnsF Set TermReference TermReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF Set TermReferenceId TermReferenceId)
conflicts
]
defnsReferences ::
Defns (BiMultimap Referent name) (BiMultimap TypeReference name) ->
DefnsF Set TermReference TypeReference
defnsReferences :: forall name.
Defns (BiMultimap Referent name) (BiMultimap TermReference name)
-> DefnsF Set TermReference TermReference
defnsReferences Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns =
(DefnsF Set TermReference TermReference
-> Referent -> DefnsF Set TermReference TermReference)
-> DefnsF Set TermReference TermReference
-> [Referent]
-> DefnsF Set TermReference TermReference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' DefnsF Set TermReference TermReference
-> Referent -> DefnsF Set TermReference TermReference
f Defns {$sel:terms:Defns :: Set TermReference
terms = Set TermReference
forall a. Set a
Set.empty, $sel:types:Defns :: Set TermReference
types = BiMultimap TermReference name -> Set TermReference
forall a b. BiMultimap a b -> Set a
BiMultimap.dom Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns.types} (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (BiMultimap Referent name -> Set Referent
forall a b. BiMultimap a b -> Set a
BiMultimap.dom Defns (BiMultimap Referent name) (BiMultimap TermReference name)
defns.terms))
where
f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference
f :: DefnsF Set TermReference TermReference
-> Referent -> DefnsF Set TermReference TermReference
f DefnsF Set TermReference TermReference
acc = \case
Referent.Con (ConstructorReference TermReference
ref ConstructorId
_) ConstructorType
_ ->
let !types :: Set TermReference
types = TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReference
ref DefnsF Set TermReference TermReference
acc.types
in Defns {$sel:terms:Defns :: Set TermReference
terms = DefnsF Set TermReference TermReference
acc.terms, Set TermReference
$sel:types:Defns :: Set TermReference
types :: Set TermReference
types}
Referent.Ref TermReference
ref ->
let !terms :: Set TermReference
terms = TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReference
ref DefnsF Set TermReference TermReference
acc.terms
in Defns {Set TermReference
$sel:terms:Defns :: Set TermReference
terms :: Set TermReference
terms, $sel:types:Defns :: Set TermReference
types = DefnsF Set TermReference TermReference
acc.types}