module Unison.Merge.PartitionCombinedDiffs
  ( partitionCombinedDiffs,
    narrowConflictsToNonBuiltins,
  )
where

import Control.Lens (Lens')
import Data.Bitraversable (bitraverse)
import Data.Map.Strict qualified as Map
import Unison.DeclNameLookup (DeclNameLookup (..), expectConstructorNames, expectDeclName)
import Unison.Merge.CombineDiffs (CombinedDiffOp (..))
import Unison.Merge.EitherWay (EitherWay (..))
import Unison.Merge.EitherWay qualified as EitherWay
import Unison.Merge.EitherWayI (EitherWayI (..))
import Unison.Merge.EitherWayI qualified as EitherWayI
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.TwoWay qualified as TwoWay
import Unison.Merge.TwoWayI (TwoWayI (..))
import Unison.Merge.TwoWayI qualified as TwoWayI
import Unison.Merge.Unconflicts (Unconflicts (..))
import Unison.Merge.Unconflicts qualified as Unconflicts
import Unison.Merge.Updated (Updated (..))
import Unison.Name (Name)
import Unison.Prelude hiding (catMaybes)
import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defn (Defn (..))
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, defnsAreEmpty)
import Unison.Util.Map qualified as Map

-- | Combine LCA->Alice diff and LCA->Bob diff, then partition into conflicted and unconflicted things.
partitionCombinedDiffs ::
  TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
  TwoWay DeclNameLookup ->
  DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference ->
  ( TwoWay (DefnsF (Map Name) TermReference TypeReference),
    DefnsF Unconflicts Referent TypeReference
  )
partitionCombinedDiffs :: TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> TwoWay DeclNameLookup
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> (TwoWay
      (Defns (Map Name TypeReference) (Map Name TypeReference)),
    DefnsF Unconflicts Referent TypeReference)
partitionCombinedDiffs TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns TwoWay DeclNameLookup
declNameLookups DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diffs =
  let conflicts :: TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts = HasCallStack =>
TwoWay DeclNameLookup
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
TwoWay DeclNameLookup
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
identifyConflicts TwoWay DeclNameLookup
declNameLookups TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diffs
   in (TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts, TwoWay DeclNameLookup
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> DefnsF Unconflicts Referent TypeReference
identifyUnconflicts TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diffs)

data S = S
  { S -> EitherWay ()
me :: !(EitherWay ()),
    S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts :: !(TwoWay (DefnsF (Map Name) TermReference TypeReference)),
    S -> TwoWay (DefnsF [] Name Name)
stacks :: !(TwoWay (DefnsF [] Name Name))
  }
  deriving stock ((forall x. S -> Rep S x) -> (forall x. Rep S x -> S) -> Generic S
forall x. Rep S x -> S
forall x. S -> Rep S x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. S -> Rep S x
from :: forall x. S -> Rep S x
$cto :: forall x. Rep S x -> S
to :: forall x. Rep S x -> S
Generic)

makeInitialIdentifyConflictsState :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> S
makeInitialIdentifyConflictsState :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> S
makeInitialIdentifyConflictsState DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff =
  S
    { $sel:me:S :: EitherWay ()
me = () -> EitherWay ()
forall a. a -> EitherWay a
Alice (), -- arbitrary initial person
      $sel:conflicts:S :: TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts = TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
forall a. Monoid a => a
mempty,
      $sel:stacks:S :: TwoWay (DefnsF [] Name Name)
stacks =
        let f :: Map Name (CombinedDiffOp a) -> TwoWay [Name]
f = [Name] -> TwoWay [Name]
forall a. a -> TwoWay a
TwoWay.bothWays ([Name] -> TwoWay [Name])
-> (Map Name (CombinedDiffOp a) -> [Name])
-> Map Name (CombinedDiffOp a)
-> TwoWay [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name (CombinedDiffOp a) -> [Name]
forall a. Map Name (CombinedDiffOp a) -> [Name]
justTheConflictedNames
         in (Map Name (CombinedDiffOp Referent) -> TwoWay [Name])
-> (Map Name (CombinedDiffOp TypeReference) -> TwoWay [Name])
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> TwoWay (DefnsF [] Name Name)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Map Name (CombinedDiffOp Referent) -> TwoWay [Name]
forall {a}. Map Name (CombinedDiffOp a) -> TwoWay [Name]
f Map Name (CombinedDiffOp TypeReference) -> TwoWay [Name]
forall {a}. Map Name (CombinedDiffOp a) -> TwoWay [Name]
f DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
diff
    }

identifyConflicts ::
  (HasCallStack) =>
  TwoWay DeclNameLookup ->
  TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
  DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference ->
  TwoWay (DefnsF (Map Name) TermReference TypeReference)
identifyConflicts :: HasCallStack =>
TwoWay DeclNameLookup
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
identifyConflicts TwoWay DeclNameLookup
declNameLookups TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns =
  S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
loop (S
 -> TwoWay
      (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> (DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> S)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> S
makeInitialIdentifyConflictsState
  where
    loop :: S -> TwoWay (DefnsF (Map Name) TermReference TypeReference)
    loop :: S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
loop S
s =
      case (Getting [Name] S [Name] -> S -> [Name]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Name] S [Name]
Lens' S [Name]
myTermStack_ S
s, Getting [Name] S [Name] -> S -> [Name]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Name] S [Name]
Lens' S [Name]
myTypeStack_ S
s, DefnsF [] Name Name -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty (Getting (DefnsF [] Name Name) S (DefnsF [] Name Name)
-> S -> DefnsF [] Name Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (DefnsF [] Name Name) S (DefnsF [] Name Name)
Lens' S (DefnsF [] Name Name)
theirStacks_ S
s)) of
        (Name
name : [Name]
names, [Name]
_, Bool
_) -> S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
loop (Name -> S -> S
poppedTerm Name
name (S
s S -> (S -> S) -> S
forall a b. a -> (a -> b) -> b
& ([Name] -> Identity [Name]) -> S -> Identity S
Lens' S [Name]
myTermStack_ (([Name] -> Identity [Name]) -> S -> Identity S)
-> [Name] -> S -> S
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Name]
names))
        ([], Name
name : [Name]
names, Bool
_) -> S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
loop (Name -> S -> S
poppedType Name
name (S
s S -> (S -> S) -> S
forall a b. a -> (a -> b) -> b
& ([Name] -> Identity [Name]) -> S -> Identity S
Lens' S [Name]
myTypeStack_ (([Name] -> Identity [Name]) -> S -> Identity S)
-> [Name] -> S -> S
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Name]
names))
        ([], [], Bool
False) -> S
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
loop (S
s S -> (S -> S) -> S
forall a b. a -> (a -> b) -> b
& ASetter S S (EitherWay ()) (EitherWay ())
#me ASetter S S (EitherWay ()) (EitherWay ())
-> (EitherWay () -> EitherWay ()) -> S -> S
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EitherWay () -> EitherWay ()
forall a. EitherWay a -> EitherWay a
EitherWay.swap)
        ([], [], Bool
True) -> S
s.conflicts
      where
        poppedTerm :: Name -> S -> S
        poppedTerm :: Name -> S -> S
poppedTerm Name
name =
          case Name -> BiMultimap Referent Name -> Maybe Referent
forall b a. Ord b => b -> BiMultimap a b -> Maybe a
BiMultimap.lookupRan Name
name (Getting
  (BiMultimap Referent Name)
  (TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)))
  (BiMultimap Referent Name)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> BiMultimap Referent Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BiMultimap Referent Name)
  (TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)))
  (BiMultimap Referent Name)
forall terms types (f :: * -> *).
Functor f =>
(terms -> f terms)
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
myTerms_ TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns) of
            Maybe Referent
Nothing -> S -> S
forall a. a -> a
id
            Just (Referent.Ref TypeReference
ref) -> ASetter S S (Map Name TypeReference) (Map Name TypeReference)
-> (Map Name TypeReference -> Map Name TypeReference) -> S -> S
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter S S (Map Name TypeReference) (Map Name TypeReference)
Lens' S (Map Name TypeReference)
myTermConflicts_ (Name
-> TypeReference
-> Map Name TypeReference
-> Map Name TypeReference
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name TypeReference
ref)
            Just (Referent.Con ConstructorReference
_ ConstructorType
_) -> (([Name] -> Identity [Name]) -> S -> Identity S)
-> ([Name] -> [Name]) -> S -> S
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ([Name] -> Identity [Name]) -> S -> Identity S
Lens' S [Name]
myTypeStack_ (HasCallStack => DeclNameLookup -> Name -> Name
DeclNameLookup -> Name -> Name
expectDeclName DeclNameLookup
myDeclNameLookup Name
name Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:)

        poppedType :: Name -> S -> S
        poppedType :: Name -> S -> S
poppedType Name
name S
s =
          S -> Maybe S -> S
forall a. a -> Maybe a -> a
fromMaybe S
s do
            TypeReference
ref <- Name -> BiMultimap TypeReference Name -> Maybe TypeReference
forall b a. Ord b => b -> BiMultimap a b -> Maybe a
BiMultimap.lookupRan Name
name (Getting
  (BiMultimap TypeReference Name)
  (TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)))
  (BiMultimap TypeReference Name)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
-> BiMultimap TypeReference Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BiMultimap TypeReference Name)
  (TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)))
  (BiMultimap TypeReference Name)
forall terms types (f :: * -> *).
Functor f =>
(types -> f types)
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
myTypes_ TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
defns)
            -- Bail early here (by returning Nothing in the first argument to upsertF) if we've already recorded this
            -- type as conflicted, because in that case we've already added its constructor names to the other person's
            -- term stack, and we only want to do that once.
            Map Name TypeReference
typeConflicts <- (Maybe TypeReference -> Maybe TypeReference)
-> Name -> Map Name TypeReference -> Maybe (Map Name TypeReference)
forall (f :: * -> *) k v.
(Functor f, Ord k) =>
(Maybe v -> f v) -> k -> Map k v -> f (Map k v)
Map.upsertF (Maybe TypeReference
-> (TypeReference -> Maybe TypeReference)
-> Maybe TypeReference
-> Maybe TypeReference
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just TypeReference
ref) (Maybe TypeReference -> TypeReference -> Maybe TypeReference
forall a b. a -> b -> a
const Maybe TypeReference
forall a. Maybe a
Nothing)) Name
name (Getting (Map Name TypeReference) S (Map Name TypeReference)
-> S -> Map Name TypeReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Name TypeReference) S (Map Name TypeReference)
Lens' S (Map Name TypeReference)
myTypeConflicts_ S
s)
            S -> Maybe S
forall a. a -> Maybe a
Just (S -> Maybe S) -> S -> Maybe S
forall a b. (a -> b) -> a -> b
$
              S
s
                S -> (S -> S) -> S
forall a b. a -> (a -> b) -> b
& ASetter S S (Map Name TypeReference) (Map Name TypeReference)
Lens' S (Map Name TypeReference)
myTypeConflicts_ ASetter S S (Map Name TypeReference) (Map Name TypeReference)
-> Map Name TypeReference -> S -> S
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Name TypeReference
typeConflicts
                S -> (S -> S) -> S
forall a b. a -> (a -> b) -> b
& case TypeReference
ref of
                  ReferenceBuiltin Text
_ -> S -> S
forall a. a -> a
id -- builtin types don't have constructors
                  ReferenceDerived Id' Hash
_ -> ([Name] -> Identity [Name]) -> S -> Identity S
Lens' S [Name]
theirTermStack_ (([Name] -> Identity [Name]) -> S -> Identity S)
-> ([Name] -> [Name]) -> S -> S
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
expectConstructorNames DeclNameLookup
myDeclNameLookup Name
name [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++)

        me_ :: Lens' (TwoWay a) a
        me_ :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_ = EitherWay () -> Lens' (TwoWay a) a
forall x a. EitherWay x -> Lens' (TwoWay a) a
TwoWay.who_ S
s.me

        myTerms_ :: Lens' (TwoWay (Defns terms types)) terms
        myTerms_ :: forall terms types (f :: * -> *).
Functor f =>
(terms -> f terms)
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
myTerms_ = (Defns terms types -> f (Defns terms types))
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_ ((Defns terms types -> f (Defns terms types))
 -> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types)))
-> ((terms -> f terms)
    -> Defns terms types -> f (Defns terms types))
-> (terms -> f terms)
-> TwoWay (Defns terms types)
-> f (TwoWay (Defns terms types))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (terms -> f terms) -> Defns terms types -> f (Defns terms types)
#terms

        myTypes_ :: Lens' (TwoWay (Defns terms types)) types
        myTypes_ :: forall terms types (f :: * -> *).
Functor f =>
(types -> f types)
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
myTypes_ = (Defns terms types -> f (Defns terms types))
-> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types))
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_ ((Defns terms types -> f (Defns terms types))
 -> TwoWay (Defns terms types) -> f (TwoWay (Defns terms types)))
-> ((types -> f types)
    -> Defns terms types -> f (Defns terms types))
-> (types -> f types)
-> TwoWay (Defns terms types)
-> f (TwoWay (Defns terms types))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (types -> f types) -> Defns terms types -> f (Defns terms types)
#types

        myConflicts_ :: Lens' S (DefnsF (Map Name) TermReference TypeReference)
        myConflicts_ :: Lens' S (Defns (Map Name TypeReference) (Map Name TypeReference))
myConflicts_ = (TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
 -> f (TwoWay
         (Defns (Map Name TypeReference) (Map Name TypeReference))))
-> S -> f S
#conflicts ((TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
  -> f (TwoWay
          (Defns (Map Name TypeReference) (Map Name TypeReference))))
 -> S -> f S)
-> ((Defns (Map Name TypeReference) (Map Name TypeReference)
     -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
    -> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
    -> f (TwoWay
            (Defns (Map Name TypeReference) (Map Name TypeReference))))
-> (Defns (Map Name TypeReference) (Map Name TypeReference)
    -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> f (TwoWay
        (Defns (Map Name TypeReference) (Map Name TypeReference)))
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_

        myTermConflicts_ :: Lens' S (Map Name TermReference)
        myTermConflicts_ :: Lens' S (Map Name TypeReference)
myTermConflicts_ = (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> S -> f S
Lens' S (Defns (Map Name TypeReference) (Map Name TypeReference))
myConflicts_ ((Defns (Map Name TypeReference) (Map Name TypeReference)
  -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
 -> S -> f S)
-> ((Map Name TypeReference -> f (Map Name TypeReference))
    -> Defns (Map Name TypeReference) (Map Name TypeReference)
    -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> (Map Name TypeReference -> f (Map Name TypeReference))
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name TypeReference -> f (Map Name TypeReference))
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> f (Defns (Map Name TypeReference) (Map Name TypeReference))
#terms

        myTypeConflicts_ :: Lens' S (Map Name TermReference)
        myTypeConflicts_ :: Lens' S (Map Name TypeReference)
myTypeConflicts_ = (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> S -> f S
Lens' S (Defns (Map Name TypeReference) (Map Name TypeReference))
myConflicts_ ((Defns (Map Name TypeReference) (Map Name TypeReference)
  -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
 -> S -> f S)
-> ((Map Name TypeReference -> f (Map Name TypeReference))
    -> Defns (Map Name TypeReference) (Map Name TypeReference)
    -> f (Defns (Map Name TypeReference) (Map Name TypeReference)))
-> (Map Name TypeReference -> f (Map Name TypeReference))
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name TypeReference -> f (Map Name TypeReference))
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> f (Defns (Map Name TypeReference) (Map Name TypeReference))
#types

        myStacks_ :: Lens' S (DefnsF [] Name Name)
        myStacks_ :: Lens' S (DefnsF [] Name Name)
myStacks_ = (TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name)))
-> S -> f S
#stacks ((TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name)))
 -> S -> f S)
-> ((DefnsF [] Name Name -> f (DefnsF [] Name Name))
    -> TwoWay (DefnsF [] Name Name)
    -> f (TwoWay (DefnsF [] Name Name)))
-> (DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name))
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_

        myTermStack_ :: Lens' S [Name]
        myTermStack_ :: Lens' S [Name]
myTermStack_ = (DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S
Lens' S (DefnsF [] Name Name)
myStacks_ ((DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S)
-> (([Name] -> f [Name])
    -> DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> ([Name] -> f [Name])
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> f [Name])
-> DefnsF [] Name Name -> f (DefnsF [] Name Name)
#terms

        myTypeStack_ :: Lens' S [Name]
        myTypeStack_ :: Lens' S [Name]
myTypeStack_ = (DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S
Lens' S (DefnsF [] Name Name)
myStacks_ ((DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S)
-> (([Name] -> f [Name])
    -> DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> ([Name] -> f [Name])
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> f [Name])
-> DefnsF [] Name Name -> f (DefnsF [] Name Name)
#types

        myDeclNameLookup :: DeclNameLookup
        myDeclNameLookup :: DeclNameLookup
myDeclNameLookup = Getting DeclNameLookup (TwoWay DeclNameLookup) DeclNameLookup
-> TwoWay DeclNameLookup -> DeclNameLookup
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DeclNameLookup (TwoWay DeclNameLookup) DeclNameLookup
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
me_ TwoWay DeclNameLookup
declNameLookups

        them_ :: Lens' (TwoWay a) a
        them_ :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
them_ = EitherWay () -> Lens' (TwoWay a) a
forall x a. EitherWay x -> Lens' (TwoWay a) a
TwoWay.who_ (EitherWay () -> EitherWay ()
forall a. EitherWay a -> EitherWay a
EitherWay.swap S
s.me)

        theirStacks_ :: Lens' S (DefnsF [] Name Name)
        theirStacks_ :: Lens' S (DefnsF [] Name Name)
theirStacks_ = (TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name)))
-> S -> f S
#stacks ((TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name)))
 -> S -> f S)
-> ((DefnsF [] Name Name -> f (DefnsF [] Name Name))
    -> TwoWay (DefnsF [] Name Name)
    -> f (TwoWay (DefnsF [] Name Name)))
-> (DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> TwoWay (DefnsF [] Name Name) -> f (TwoWay (DefnsF [] Name Name))
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> TwoWay a -> f (TwoWay a)
them_

        theirTermStack_ :: Lens' S [Name]
        theirTermStack_ :: Lens' S [Name]
theirTermStack_ = (DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S
Lens' S (DefnsF [] Name Name)
theirStacks_ ((DefnsF [] Name Name -> f (DefnsF [] Name Name)) -> S -> f S)
-> (([Name] -> f [Name])
    -> DefnsF [] Name Name -> f (DefnsF [] Name Name))
-> ([Name] -> f [Name])
-> S
-> f S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> f [Name])
-> DefnsF [] Name Name -> f (DefnsF [] Name Name)
#terms

identifyUnconflicts ::
  TwoWay DeclNameLookup ->
  TwoWay (DefnsF (Map Name) TermReference TypeReference) ->
  DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference ->
  DefnsF Unconflicts Referent TypeReference
identifyUnconflicts :: TwoWay DeclNameLookup
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> DefnsF Unconflicts Referent TypeReference
identifyUnconflicts TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts =
  (Map Name (CombinedDiffOp Referent) -> Unconflicts Referent)
-> (Map Name (CombinedDiffOp TypeReference)
    -> Unconflicts TypeReference)
-> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference
-> DefnsF Unconflicts 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 (TwoWay DeclNameLookup
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> Map Name (CombinedDiffOp Referent)
-> Unconflicts Referent
identifyTermUnconflicts TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts) (TwoWay (Map Name TypeReference)
-> Map Name (CombinedDiffOp TypeReference)
-> Unconflicts TypeReference
identifyTypeUnconflicts (Getting
  (Map Name TypeReference)
  (Defns (Map Name TypeReference) (Map Name TypeReference))
  (Map Name TypeReference)
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> Map Name TypeReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name TypeReference)
  (Defns (Map Name TypeReference) (Map Name TypeReference))
  (Map Name TypeReference)
#types (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> Map Name TypeReference)
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> TwoWay (Map Name TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts))

identifyTermUnconflicts ::
  TwoWay DeclNameLookup ->
  TwoWay (DefnsF (Map Name) TermReference TypeReference) ->
  Map Name (CombinedDiffOp Referent) ->
  Unconflicts Referent
identifyTermUnconflicts :: TwoWay DeclNameLookup
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> Map Name (CombinedDiffOp Referent)
-> Unconflicts Referent
identifyTermUnconflicts TwoWay DeclNameLookup
declNameLookups TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts =
  (Unconflicts Referent
 -> Name -> CombinedDiffOp Referent -> Unconflicts Referent)
-> Unconflicts Referent
-> Map Name (CombinedDiffOp Referent)
-> Unconflicts Referent
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Unconflicts Referent
acc Name
name CombinedDiffOp Referent
op -> Name
-> CombinedDiffOp Referent
-> Unconflicts Referent
-> Unconflicts Referent
f Name
name CombinedDiffOp Referent
op Unconflicts Referent
acc) Unconflicts Referent
forall v. Unconflicts v
Unconflicts.empty
  where
    f :: Name -> CombinedDiffOp Referent -> Unconflicts Referent -> Unconflicts Referent
    f :: Name
-> CombinedDiffOp Referent
-> Unconflicts Referent
-> Unconflicts Referent
f Name
name = \case
      CombinedDiffOp'Add EitherWayI Referent
who ->
        case EitherWayI Referent -> Referent
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI Referent
who of
          Referent.Ref TypeReference
_ -> Unconflicts Referent -> Unconflicts Referent
keepIt1
          Referent.Con ConstructorReference
_ ConstructorType
_ -> if EitherWayI Referent -> Bool
forall a. EitherWayI a -> Bool
constructor EitherWayI Referent
who then Unconflicts Referent -> Unconflicts Referent
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts Referent -> Unconflicts Referent
keepIt1
        where
          keepIt1 :: Unconflicts Referent -> Unconflicts Referent
keepIt1 = Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
-> EitherWayI Referent
-> Name
-> Unconflicts Referent
-> Unconflicts Referent
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt (TwoWayI (Map Name Referent) -> f (TwoWayI (Map Name Referent)))
-> Unconflicts Referent -> f (Unconflicts Referent)
Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
#adds EitherWayI Referent
who Name
name
      CombinedDiffOp'Update EitherWayI (Updated Referent)
who ->
        case (EitherWayI (Updated Referent) -> Updated Referent
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI (Updated Referent)
who).new of
          Referent.Ref TypeReference
_ ->
            case EitherWayI (Updated Referent)
who of
              OnlyAlice Updated Referent
_ -> if TwoWay Bool
termIsConflicted.alice then Unconflicts Referent -> Unconflicts Referent
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts Referent -> Unconflicts Referent
keepIt1
              OnlyBob Updated Referent
_ -> if TwoWay Bool
termIsConflicted.bob then Unconflicts Referent -> Unconflicts Referent
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts Referent -> Unconflicts Referent
keepIt1
              AliceAndBob Updated Referent
_ -> Unconflicts Referent -> Unconflicts Referent
keepIt1
          Referent.Con ConstructorReference
_ ConstructorType
_ -> if EitherWayI (Updated Referent) -> Bool
forall a. EitherWayI a -> Bool
constructor EitherWayI (Updated Referent)
who then Unconflicts Referent -> Unconflicts Referent
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts Referent -> Unconflicts Referent
keepIt1
        where
          keepIt1 :: Unconflicts Referent -> Unconflicts Referent
keepIt1 = Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
-> EitherWayI Referent
-> Name
-> Unconflicts Referent
-> Unconflicts Referent
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt (TwoWayI (Map Name Referent) -> f (TwoWayI (Map Name Referent)))
-> Unconflicts Referent -> f (Unconflicts Referent)
Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
#updates (Getting Referent (Updated Referent) Referent
-> Updated Referent -> Referent
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Referent (Updated Referent) Referent
#new (Updated Referent -> Referent)
-> EitherWayI (Updated Referent) -> EitherWayI Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EitherWayI (Updated Referent)
who) Name
name
      CombinedDiffOp'Delete EitherWayI Referent
who -> Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
-> EitherWayI Referent
-> Name
-> Unconflicts Referent
-> Unconflicts Referent
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt (TwoWayI (Map Name Referent) -> f (TwoWayI (Map Name Referent)))
-> Unconflicts Referent -> f (Unconflicts Referent)
Lens' (Unconflicts Referent) (TwoWayI (Map Name Referent))
#deletes EitherWayI Referent
who Name
name
      CombinedDiffOp'Conflict TwoWay Referent
_ -> Unconflicts Referent -> Unconflicts Referent
forall v. Unconflicts v -> Unconflicts v
ignoreIt
      where
        -- Ignore added/updated constructors whose types are conflicted
        constructor :: EitherWayI a -> Bool
        constructor :: forall a. EitherWayI a -> Bool
constructor = \case
          OnlyAlice a
_ -> TwoWay Bool
constructorHasConflictedType.alice
          OnlyBob a
_ -> TwoWay Bool
constructorHasConflictedType.bob
          AliceAndBob a
_ -> TwoWay Bool -> Bool
TwoWay.or TwoWay Bool
constructorHasConflictedType

        constructorHasConflictedType :: TwoWay Bool
        constructorHasConflictedType :: TwoWay Bool
constructorHasConflictedType =
          (\Defns (Map Name TypeReference) (Map Name TypeReference)
conflicts1 DeclNameLookup
declNameLookup -> Name -> Map Name TypeReference -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (HasCallStack => DeclNameLookup -> Name -> Name
DeclNameLookup -> Name -> Name
expectDeclName DeclNameLookup
declNameLookup Name
name) Defns (Map Name TypeReference) (Map Name TypeReference)
conflicts1.types)
            (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> DeclNameLookup -> Bool)
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> TwoWay (DeclNameLookup -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts
            TwoWay (DeclNameLookup -> Bool)
-> TwoWay DeclNameLookup -> TwoWay Bool
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwoWay DeclNameLookup
declNameLookups

        termIsConflicted :: TwoWay Bool
        termIsConflicted :: TwoWay Bool
termIsConflicted =
          Name -> Map Name TypeReference -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Name
name (Map Name TypeReference -> Bool)
-> (Defns (Map Name TypeReference) (Map Name TypeReference)
    -> Map Name TypeReference)
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Map Name TypeReference)
  (Defns (Map Name TypeReference) (Map Name TypeReference))
  (Map Name TypeReference)
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> Map Name TypeReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name TypeReference)
  (Defns (Map Name TypeReference) (Map Name TypeReference))
  (Map Name TypeReference)
#terms (Defns (Map Name TypeReference) (Map Name TypeReference) -> Bool)
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> TwoWay Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
conflicts

identifyTypeUnconflicts ::
  TwoWay (Map Name TypeReference) ->
  Map Name (CombinedDiffOp TypeReference) ->
  Unconflicts TypeReference
identifyTypeUnconflicts :: TwoWay (Map Name TypeReference)
-> Map Name (CombinedDiffOp TypeReference)
-> Unconflicts TypeReference
identifyTypeUnconflicts TwoWay (Map Name TypeReference)
conflicts =
  (Unconflicts TypeReference
 -> Name
 -> CombinedDiffOp TypeReference
 -> Unconflicts TypeReference)
-> Unconflicts TypeReference
-> Map Name (CombinedDiffOp TypeReference)
-> Unconflicts TypeReference
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Unconflicts TypeReference
acc Name
name CombinedDiffOp TypeReference
ref -> Name
-> CombinedDiffOp TypeReference
-> Unconflicts TypeReference
-> Unconflicts TypeReference
f Name
name CombinedDiffOp TypeReference
ref Unconflicts TypeReference
acc) Unconflicts TypeReference
forall v. Unconflicts v
Unconflicts.empty
  where
    f :: Name -> CombinedDiffOp TypeReference -> Unconflicts TypeReference -> Unconflicts TypeReference
    f :: Name
-> CombinedDiffOp TypeReference
-> Unconflicts TypeReference
-> Unconflicts TypeReference
f Name
name = \case
      CombinedDiffOp'Add EitherWayI TypeReference
who -> Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
-> EitherWayI TypeReference
-> Unconflicts TypeReference
-> Unconflicts TypeReference
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Unconflicts v -> Unconflicts v
addOrUpdate (TwoWayI (Map Name TypeReference)
 -> f (TwoWayI (Map Name TypeReference)))
-> Unconflicts TypeReference -> f (Unconflicts TypeReference)
Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
#adds EitherWayI TypeReference
who
      CombinedDiffOp'Update EitherWayI (Updated TypeReference)
who -> Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
-> EitherWayI TypeReference
-> Unconflicts TypeReference
-> Unconflicts TypeReference
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Unconflicts v -> Unconflicts v
addOrUpdate (TwoWayI (Map Name TypeReference)
 -> f (TwoWayI (Map Name TypeReference)))
-> Unconflicts TypeReference -> f (Unconflicts TypeReference)
Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
#updates (Getting TypeReference (Updated TypeReference) TypeReference
-> Updated TypeReference -> TypeReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TypeReference (Updated TypeReference) TypeReference
#new (Updated TypeReference -> TypeReference)
-> EitherWayI (Updated TypeReference) -> EitherWayI TypeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EitherWayI (Updated TypeReference)
who)
      CombinedDiffOp'Delete EitherWayI TypeReference
who -> Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
-> EitherWayI TypeReference
-> Name
-> Unconflicts TypeReference
-> Unconflicts TypeReference
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt (TwoWayI (Map Name TypeReference)
 -> f (TwoWayI (Map Name TypeReference)))
-> Unconflicts TypeReference -> f (Unconflicts TypeReference)
Lens'
  (Unconflicts TypeReference) (TwoWayI (Map Name TypeReference))
#deletes EitherWayI TypeReference
who Name
name
      CombinedDiffOp'Conflict TwoWay TypeReference
_ -> Unconflicts TypeReference -> Unconflicts TypeReference
forall v. Unconflicts v -> Unconflicts v
ignoreIt
      where
        addOrUpdate :: Lens' (Unconflicts v) (TwoWayI (Map Name v)) -> EitherWayI v -> Unconflicts v -> Unconflicts v
        addOrUpdate :: forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Unconflicts v -> Unconflicts v
addOrUpdate Lens' (Unconflicts v) (TwoWayI (Map Name v))
l EitherWayI v
who =
          case EitherWayI v
who of
            OnlyAlice v
_ -> if TwoWay Bool
typeIsConflicted.alice then Unconflicts v -> Unconflicts v
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts v -> Unconflicts v
keepIt1
            OnlyBob v
_ -> if TwoWay Bool
typeIsConflicted.bob then Unconflicts v -> Unconflicts v
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts v -> Unconflicts v
keepIt1
            AliceAndBob v
_ -> if TwoWay Bool -> Bool
TwoWay.or TwoWay Bool
typeIsConflicted then Unconflicts v -> Unconflicts v
forall v. Unconflicts v -> Unconflicts v
ignoreIt else Unconflicts v -> Unconflicts v
keepIt1
          where
            keepIt1 :: Unconflicts v -> Unconflicts v
keepIt1 = Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt (TwoWayI (Map Name v) -> f (TwoWayI (Map Name v)))
-> Unconflicts v -> f (Unconflicts v)
Lens' (Unconflicts v) (TwoWayI (Map Name v))
l EitherWayI v
who Name
name

        typeIsConflicted :: TwoWay Bool
        typeIsConflicted :: TwoWay Bool
typeIsConflicted =
          Name -> Map Name TypeReference -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Name
name (Map Name TypeReference -> Bool)
-> TwoWay (Map Name TypeReference) -> TwoWay Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (Map Name TypeReference)
conflicts

keepIt ::
  Lens' (Unconflicts v) (TwoWayI (Map Name v)) ->
  EitherWayI v ->
  Name ->
  Unconflicts v ->
  Unconflicts v
keepIt :: forall v.
Lens' (Unconflicts v) (TwoWayI (Map Name v))
-> EitherWayI v -> Name -> Unconflicts v -> Unconflicts v
keepIt Lens' (Unconflicts v) (TwoWayI (Map Name v))
what EitherWayI v
who Name
name =
  ASetter (Unconflicts v) (Unconflicts v) (Map Name v) (Map Name v)
-> (Map Name v -> Map Name v) -> Unconflicts v -> Unconflicts v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((TwoWayI (Map Name v) -> Identity (TwoWayI (Map Name v)))
-> Unconflicts v -> Identity (Unconflicts v)
Lens' (Unconflicts v) (TwoWayI (Map Name v))
what ((TwoWayI (Map Name v) -> Identity (TwoWayI (Map Name v)))
 -> Unconflicts v -> Identity (Unconflicts v))
-> ((Map Name v -> Identity (Map Name v))
    -> TwoWayI (Map Name v) -> Identity (TwoWayI (Map Name v)))
-> ASetter
     (Unconflicts v) (Unconflicts v) (Map Name v) (Map Name v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherWayI v -> Lens' (TwoWayI (Map Name v)) (Map Name v)
forall x a. EitherWayI x -> Lens' (TwoWayI a) a
TwoWayI.who_ EitherWayI v
who) (Name -> v -> Map Name v -> Map Name v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name (EitherWayI v -> v
forall a. EitherWayI a -> a
EitherWayI.value EitherWayI v
who))

ignoreIt :: Unconflicts v -> Unconflicts v
ignoreIt :: forall v. Unconflicts v -> Unconflicts v
ignoreIt =
  Unconflicts v -> Unconflicts v
forall a. a -> a
id

-- Given a combined diff, return the names that are conflicted.
justTheConflictedNames :: Map Name (CombinedDiffOp a) -> [Name]
justTheConflictedNames :: forall a. Map Name (CombinedDiffOp a) -> [Name]
justTheConflictedNames =
  ([Name] -> Name -> CombinedDiffOp a -> [Name])
-> [Name] -> Map Name (CombinedDiffOp a) -> [Name]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' [Name] -> Name -> CombinedDiffOp a -> [Name]
forall term. [Name] -> Name -> CombinedDiffOp term -> [Name]
f []
  where
    f :: [Name] -> Name -> CombinedDiffOp term -> [Name]
    f :: forall term. [Name] -> Name -> CombinedDiffOp term -> [Name]
f [Name]
names Name
name = \case
      CombinedDiffOp'Conflict TwoWay term
_ -> Name
name Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
names
      CombinedDiffOp'Add EitherWayI term
_ -> [Name]
names
      CombinedDiffOp'Delete EitherWayI term
_ -> [Name]
names
      CombinedDiffOp'Update EitherWayI (Updated term)
_ -> [Name]
names

narrowConflictsToNonBuiltins ::
  TwoWay (DefnsF (Map Name) TermReference TypeReference) ->
  Either (Defn Name Name) (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId))
narrowConflictsToNonBuiltins :: TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> Either
     (Defn Name Name) (TwoWay (DefnsF (Map Name) (Id' Hash) (Id' Hash)))
narrowConflictsToNonBuiltins =
  (Defns (Map Name TypeReference) (Map Name TypeReference)
 -> Either
      (Defn Name Name) (DefnsF (Map Name) (Id' Hash) (Id' Hash)))
-> TwoWay (Defns (Map Name TypeReference) (Map Name TypeReference))
-> Either
     (Defn Name Name) (TwoWay (DefnsF (Map Name) (Id' Hash) (Id' Hash)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TwoWay a -> f (TwoWay b)
traverse ((Map Name TypeReference
 -> Either (Defn Name Name) (Map Name (Id' Hash)))
-> (Map Name TypeReference
    -> Either (Defn Name Name) (Map Name (Id' Hash)))
-> Defns (Map Name TypeReference) (Map Name TypeReference)
-> Either
     (Defn Name Name) (DefnsF (Map Name) (Id' Hash) (Id' Hash))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Name -> TypeReference -> Either (Defn Name Name) (Id' Hash))
-> Map Name TypeReference
-> Either (Defn Name Name) (Map Name (Id' Hash))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Name -> TypeReference -> Either (Defn Name Name) (Id' Hash)
assertTermIsntBuiltin) ((Name -> TypeReference -> Either (Defn Name Name) (Id' Hash))
-> Map Name TypeReference
-> Either (Defn Name Name) (Map Name (Id' Hash))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Name -> TypeReference -> Either (Defn Name Name) (Id' Hash)
assertTypeIsntBuiltin))
  where
    assertTermIsntBuiltin :: Name -> TermReference -> Either (Defn Name Name) TermReferenceId
    assertTermIsntBuiltin :: Name -> TypeReference -> Either (Defn Name Name) (Id' Hash)
assertTermIsntBuiltin Name
name TypeReference
ref =
      case TypeReference -> Maybe (Id' Hash)
Reference.toId TypeReference
ref of
        Maybe (Id' Hash)
Nothing -> Defn Name Name -> Either (Defn Name Name) (Id' Hash)
forall a b. a -> Either a b
Left (Name -> Defn Name Name
forall term typ. term -> Defn term typ
TermDefn Name
name)
        Just Id' Hash
refId -> Id' Hash -> Either (Defn Name Name) (Id' Hash)
forall a b. b -> Either a b
Right Id' Hash
refId

    assertTypeIsntBuiltin :: Name -> TypeReference -> Either (Defn Name Name) TypeReferenceId
    assertTypeIsntBuiltin :: Name -> TypeReference -> Either (Defn Name Name) (Id' Hash)
assertTypeIsntBuiltin Name
name TypeReference
ref =
      case TypeReference -> Maybe (Id' Hash)
Reference.toId TypeReference
ref of
        Maybe (Id' Hash)
Nothing -> Defn Name Name -> Either (Defn Name Name) (Id' Hash)
forall a b. a -> Either a b
Left (Name -> Defn Name Name
forall term typ. typ -> Defn term typ
TypeDefn Name
name)
        Just Id' Hash
refId -> Id' Hash -> Either (Defn Name Name) (Id' Hash)
forall a b. b -> Either a b
Right Id' Hash
refId