{- | Conflict resolution for 'RepoPatchV3' -}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.V3.Resolution () where

import qualified Data.Set as S

import Darcs.Prelude
import Data.List ( partition, sort )

import Darcs.Patch.Commute ( commuteFL )
import Darcs.Patch.Conflict ( Conflict(..), mangleOrFail )
import Darcs.Patch.Ident ( Ident(..), SignedId(..), StorableId(..) )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Patch.Prim.WithName ( PrimWithName, wnPatch )
import Darcs.Patch.V3.Contexted ( Contexted, ctxDepends, ctxId, ctxToFL )
import Darcs.Patch.V3.Core ( RepoPatchV3(..), (+|), (-|) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), mapFL_FL, (:>)(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )


-- * Conflict Resolution

{- This gives an overview of the algorithm for marking conflicts.

The goal is to calculate the markup for a trailing RL of patches, usually
the ones we are going to add to our repo. But since in V3 we store only the
direct conflicts, not the transitive set, we also require the full context
of all previous patches.

The markup presents each /transitive/ unresolved conflict in the form of a
set of alternative changes that all apply at the end of the repo. These
alternatives form the vertices of an undirected graph, where an edge exists
between two vertices iff they conflict. We represent this graph as a list of
connected 'Component's; thus each 'Component' represents one transitive
conflict.

The graph is constructed by commuting any patch that is part of a conflict
to the head. If that succeeds, the resulting conflictor gives us all
participents of the (direct) conflict in the form of contexted patches that
apply to the end of the repo. We check if there is an overlap between this
set and any already constructed components. If this is the case, we join
them into a larger component, otherwise we add a new component. If commuting
to the head fails, we only remember the set of conflicting patch names, and
use that afterwards to connect components that might otherwise appear as
unconnected. The docs for 'findComponents' explain this in greater detail.

Each resulting 'Component' is then converted to a set of plain prim 'FL's
(removing the prim patch IDs) and passed to the mangling function to
calculate the conflict markup as a single prim patch.

The result differs from that for RepoPatchV1 in that we do not merge the
maximal independent (i.e. non-conflicting) sets for each component. While
the latter gives a theoretically valid and more compact presentation,
typically with fewer alternatives, it has some disadvantages in practice:

  * Merging means that a single alternative no longer corresponds to a
    single named patch in our repo. Thus, even if we annotate alternatives
    with patch names or hashes (as planned for V3), identifying which part
    of an alternative belongs to which named patch requires additional
    mental effort during manual resolution.

  * The same original prim is now contained in more than one alternative,
    making it harder to manually resolve the conflict in a systematic way by
    applying difference between alternatives and the baseline step by step.

-}

instance (SignedId name, StorableId name, PrimPatch prim) =>
         Conflict (RepoPatchV3 name prim) where
  isConflicted :: forall wX wY. RepoPatchV3 name prim wX wY -> Bool
isConflicted Conflictor{} = Bool
True
  isConflicted Prim{} = Bool
False
  resolveConflicts :: forall wO wX wY.
RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> [ConflictDetails (PrimOf (RepoPatchV3 name prim)) wY]
resolveConflicts RL (RepoPatchV3 name prim) wO wX
context =
      ([Sealed (FL (PrimWithName name prim) wY)]
 -> ConflictDetails prim wY)
-> [[Sealed (FL (PrimWithName name prim) wY)]]
-> [ConflictDetails prim wY]
forall a b. (a -> b) -> [a] -> [b]
map [Sealed (FL (PrimWithName name prim) wY)]
-> ConflictDetails prim wY
forall {name} {wX}.
[Sealed (FL (PrimWithName name prim) wX)]
-> ConflictDetails prim wX
resolveOne ([[Sealed (FL (PrimWithName name prim) wY)]]
 -> [ConflictDetails prim wY])
-> (RL (RepoPatchV3 name prim) wX wY
    -> [[Sealed (FL (PrimWithName name prim) wY)]])
-> RL (RepoPatchV3 name prim) wX wY
-> [ConflictDetails prim wY]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> [[Sealed (FL (PrimWithName name prim) wY)]]
forall name (prim :: * -> * -> *) wO wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> [[Sealed (FL (PrimWithName name prim) wY)]]
conflictingAlternatives RL (RepoPatchV3 name prim) wO wX
context
    where
      resolveOne :: [Sealed (FL (PrimWithName name prim) wX)]
-> ConflictDetails prim wX
resolveOne = Unravelled prim wX -> ConflictDetails prim wX
forall (prim :: * -> * -> *) wX.
PrimMangleUnravelled prim =>
Unravelled prim wX -> ConflictDetails prim wX
mangleOrFail (Unravelled prim wX -> ConflictDetails prim wX)
-> ([Sealed (FL (PrimWithName name prim) wX)]
    -> Unravelled prim wX)
-> [Sealed (FL (PrimWithName name prim) wX)]
-> ConflictDetails prim wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sealed (FL (PrimWithName name prim) wX) -> Sealed (FL prim wX))
-> [Sealed (FL (PrimWithName name prim) wX)] -> Unravelled prim wX
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX. FL (PrimWithName name prim) wX wX -> FL prim wX wX)
-> Sealed (FL (PrimWithName name prim) wX) -> Sealed (FL prim wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal ((forall wW wY. PrimWithName name prim wW wY -> prim wW wY)
-> FL (PrimWithName name prim) wX wX -> FL prim wX wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PrimWithName name prim wW wY -> prim wW wY
forall wW wY. PrimWithName name prim wW wY -> prim wW wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch))

conflictingAlternatives
  :: (SignedId name, StorableId name, PrimPatch prim)
  => RL (RepoPatchV3 name prim) wO wX
  -> RL (RepoPatchV3 name prim) wX wY
  -> [[Sealed (FL (PrimWithName name prim) wY)]]
conflictingAlternatives :: forall name (prim :: * -> * -> *) wO wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> [[Sealed (FL (PrimWithName name prim) wY)]]
conflictingAlternatives RL (RepoPatchV3 name prim) wO wX
context =
  (Set (Contexted (PrimWithName name prim) wY)
 -> [Sealed (FL (PrimWithName name prim) wY)])
-> [Set (Contexted (PrimWithName name prim) wY)]
-> [[Sealed (FL (PrimWithName name prim) wY)]]
forall a b. (a -> b) -> [a] -> [b]
map ((Contexted (PrimWithName name prim) wY
 -> Sealed (FL (PrimWithName name prim) wY))
-> [Contexted (PrimWithName name prim) wY]
-> [Sealed (FL (PrimWithName name prim) wY)]
forall a b. (a -> b) -> [a] -> [b]
map Contexted (PrimWithName name prim) wY
-> Sealed (FL (PrimWithName name prim) wY)
forall (p :: * -> * -> *) wX. Contexted p wX -> Sealed (FL p wX)
ctxToFL ([Contexted (PrimWithName name prim) wY]
 -> [Sealed (FL (PrimWithName name prim) wY)])
-> (Set (Contexted (PrimWithName name prim) wY)
    -> [Contexted (PrimWithName name prim) wY])
-> Set (Contexted (PrimWithName name prim) wY)
-> [Sealed (FL (PrimWithName name prim) wY)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Contexted (PrimWithName name prim) wY)
-> [Contexted (PrimWithName name prim) wY]
forall a. Set a -> [a]
S.toList) ([Set (Contexted (PrimWithName name prim) wY)]
 -> [[Sealed (FL (PrimWithName name prim) wY)]])
-> (RL (RepoPatchV3 name prim) wX wY
    -> [Set (Contexted (PrimWithName name prim) wY)])
-> RL (RepoPatchV3 name prim) wX wY
-> [[Sealed (FL (PrimWithName name prim) wY)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> [Set (Contexted (PrimWithName name prim) wY)]
forall name (prim :: * -> * -> *) wO wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY -> [Component name prim wY]
findComponents RL (RepoPatchV3 name prim) wO wX
context

-- | A connected component of the conflict graph.
type Component name prim wY = S.Set (Contexted (PrimWithName name prim) wY)

{- | Construct the conflict graph by searching the history for unresolved
conflicts. The history is split into an initial 'RL' of patches (the
context) and a trailing 'RL' of patches we are interested in.

We examine patches starting with the head and going backwards, maintaining
the following state:

  @done@

    A list of 'Component's, initially empty, which will become the resulting
    conflict graph.

  @todo@

    A set of @name@s, initially empty, that are candidates for inspection,
    in addition to conflicted patches in the trailing 'RL'. We maintain the
    invariant that this set never contains the @name@ of any patch we have
    already traversed.

  @res@

    A list of sets of @name@s, initially empty, with the @name@s of patches
    involved in conflicts that are (partially) resolved. Used to post
    process the result (see below).

We inspect any conflictor in the trailing 'RL', as well as any patch whose
@name@ is in @todo@ throughout the history, terminating early if the
trailing 'RL' and @todo@ are both exhausted.

For each such candidate we first try to commute it to the head.

If that succeeds, then its commuted version must be a conflictor. (Either it
was a conflictor to begin with, in which case it remains one; or it is a
patch that a later conflictor conflicted with, and that means it must itself
become conflicted when commuted to the head.) The contexted patch that the
(commuted) conflictor represents, together with its set of conflicts, is
either added as a new component to @done@, or else is joined with some
already found component.

If the commute does not succeed, then this indicates that some later patch
has resolved (parts of) the conflict. So this patch makes no direct
contribution to the confict graph. However, it may still be part of a larger
transitive conflict and not all patches involved may have been fully
resolved. (Remember that the commute rules for V3 are such that a patch
depends on a conflictor if it depends on /any/ of the patches involved in
the conflict.) To make sure that the result is independent of the order of
patches, we need to remember the set of directly conflicting patches (by
adding it to @res@). When the traversal terminates, we use this information
to join any components connected by these sets into larger components. See
the discussion below for details.

In both cases, if the patch is conflicted, we insert any patch that the
candidate conflicts with into @todo@ (and remove the patch itself). Note
that in order to maintain our invariant, we must extract the set of
conflicts from the patch /in its uncommuted form/. (If we took them from the
commuted version, then we might mark patches that we already traversed.)

The necessity to remember information about all direct conflicts until the
end, regardless of partial resolutions, can be seen with the following
example. Suppose we have patches A;B;C;D;E where E (a partial resolution)
depends (only) on C, and we have direct conflicts A/C, C/B, B/D. So D
commutes past E but conflicts only indirectly with C. Thus when we encounter
C and fail to remember the fact that it conflicts with A, we end up with two
components [{C,B},{A,D}] instead of a single transitive conflict [{A,B,C,D}]
that we would get when examining the patches in the order A;C;B;D;E.

On the other hand, suppose we have A;B;C;D;E;F, where A;B;C;D;E form a
transitive conflict chain (i.e. we have direct conflicts A/B, B/C, C/D,
D/E), and the partial resolution F depends on {B,C,D}. Note that /all/
direct conflicts involving C are resolved by F, so we expect to get the two
components {A,B} and {D,E}. Indeed, suppose the order were B;D;C;F;A;E, then
at the point after F is added we have a repo with all conflicts resolved.
Thus after adding A and E we should only see the direct conflicts of A and
E, i.e. A, B, D, and E. The slightly subtle implication is that when we
finally join components, we must do so for one conflict set at a time; it
would be wrong to first join conflict sets and then use those to join
components, since that would join {A,B} and {D,E}, even though there is no
conflict between the two sets.
-}
findComponents
  :: forall name prim wO wX wY
   . (SignedId name, StorableId name, PrimPatch prim)
  => RL (RepoPatchV3 name prim) wO wX
  -> RL (RepoPatchV3 name prim) wX wY
  -> [Component name prim wY]
findComponents :: forall name (prim :: * -> * -> *) wO wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY -> [Component name prim wY]
findComponents RL (RepoPatchV3 name prim) wO wX
context RL (RepoPatchV3 name prim) wX wY
patches = Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wX
-> RL (RepoPatchV3 name prim) wX wY
-> FL (RepoPatchV3 name prim) wY wY
-> [Component name prim wY]
forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go Set name
forall a. Set a
S.empty [] [] RL (RepoPatchV3 name prim) wO wX
context RL (RepoPatchV3 name prim) wX wY
patches FL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL where
  go :: S.Set name
     -> [Component name prim wY]
     -> [S.Set name]
     -> RL (RepoPatchV3 name prim) wO wA
     -> RL (RepoPatchV3 name prim) wA wB
     -> FL (RepoPatchV3 name prim) wB wY
     -> [Component name prim wY]
  go :: forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go Set name
todo [Component name prim wY]
done [Set name]
res RL (RepoPatchV3 name prim) wO wA
cs (RL (RepoPatchV3 name prim) wA wY
ps :<: RepoPatchV3 name prim wY wB
p) FL (RepoPatchV3 name prim) wB wY
passedby
    | RepoPatchV3 name prim wY wB -> Bool
forall wX wY. RepoPatchV3 name prim wX wY -> Bool
forall (p :: * -> * -> *) wX wY. Conflict p => p wX wY -> Bool
isConflicted RepoPatchV3 name prim wY wB
p Bool -> Bool -> Bool
|| RepoPatchV3 name prim wY wB -> PatchId (RepoPatchV3 name prim)
forall wX wY.
RepoPatchV3 name prim wX wY -> PatchId (RepoPatchV3 name prim)
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RepoPatchV3 name prim wY wB
p name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set name
todo
    , Just (FL (RepoPatchV3 name prim) wY wZ
_ :> RepoPatchV3 name prim wZ wY
p') <- (:>) (RepoPatchV3 name prim) (FL (RepoPatchV3 name prim)) wY wY
-> Maybe
     ((:>) (FL (RepoPatchV3 name prim)) (RepoPatchV3 name prim) wY wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RepoPatchV3 name prim wY wB
p RepoPatchV3 name prim wY wB
-> FL (RepoPatchV3 name prim) wB wY
-> (:>) (RepoPatchV3 name prim) (FL (RepoPatchV3 name prim)) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RepoPatchV3 name prim) wB wY
passedby) =
        Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wY
-> FL (RepoPatchV3 name prim) wY wY
-> [Component name prim wY]
forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go (RepoPatchV3 name prim wY wB -> Set name -> Set name
forall {b} {prim :: * -> * -> *} {wX} {wY}.
SignedId b =>
RepoPatchV3 b prim wX wY -> Set b -> Set b
updTodo RepoPatchV3 name prim wY wB
p Set name
todo) (RepoPatchV3 name prim wZ wY
-> [Component name prim wY] -> [Component name prim wY]
forall {name} {prim :: * -> * -> *} {wX} {wY}.
SignedId name =>
RepoPatchV3 name prim wX wY
-> [Set (Contexted (PrimWithName name prim) wY)]
-> [Set (Contexted (PrimWithName name prim) wY)]
updDone RepoPatchV3 name prim wZ wY
p' [Component name prim wY]
done) [Set name]
res RL (RepoPatchV3 name prim) wO wA
cs RL (RepoPatchV3 name prim) wA wY
ps (RepoPatchV3 name prim wY wB
p RepoPatchV3 name prim wY wB
-> FL (RepoPatchV3 name prim) wB wY
-> FL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV3 name prim) wB wY
passedby)
    | Bool
otherwise =
        Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wY
-> FL (RepoPatchV3 name prim) wY wY
-> [Component name prim wY]
forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go (RepoPatchV3 name prim wY wB -> Set name -> Set name
forall {b} {prim :: * -> * -> *} {wX} {wY}.
SignedId b =>
RepoPatchV3 b prim wX wY -> Set b -> Set b
updTodo RepoPatchV3 name prim wY wB
p Set name
todo) [Component name prim wY]
done (RepoPatchV3 name prim wY wB -> [Set name] -> [Set name]
forall {b} {prim :: * -> * -> *} {wX} {wX}.
SignedId b =>
RepoPatchV3 b prim wX wX -> [Set b] -> [Set b]
updRes RepoPatchV3 name prim wY wB
p [Set name]
res) RL (RepoPatchV3 name prim) wO wA
cs RL (RepoPatchV3 name prim) wA wY
ps (RepoPatchV3 name prim wY wB
p RepoPatchV3 name prim wY wB
-> FL (RepoPatchV3 name prim) wB wY
-> FL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV3 name prim) wB wY
passedby)
  go Set name
todo [Component name prim wY]
done [Set name]
res RL (RepoPatchV3 name prim) wO wA
_ RL (RepoPatchV3 name prim) wA wB
NilRL FL (RepoPatchV3 name prim) wB wY
_
    | Set name -> Bool
forall a. Set a -> Bool
S.null Set name
todo = [Component name prim wY] -> [Component name prim wY]
forall a. Ord a => [a] -> [a]
sort ([Component name prim wY] -> [Component name prim wY])
-> [Component name prim wY] -> [Component name prim wY]
forall a b. (a -> b) -> a -> b
$ (Component name prim wY -> Component name prim wY)
-> [Component name prim wY] -> [Component name prim wY]
forall a b. (a -> b) -> [a] -> [b]
map Component name prim wY -> Component name prim wY
purgeDeps ([Component name prim wY] -> [Component name prim wY])
-> [Component name prim wY] -> [Component name prim wY]
forall a b. (a -> b) -> a -> b
$ (Set name -> [Component name prim wY] -> [Component name prim wY])
-> [Component name prim wY]
-> [Set name]
-> [Component name prim wY]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set name -> [Component name prim wY] -> [Component name prim wY]
Set (PatchId (PrimWithName name prim))
-> [Component name prim wY] -> [Component name prim wY]
forall {p :: * -> * -> *} {wX}.
Ident p =>
Set (PatchId p) -> [Set (Contexted p wX)] -> [Set (Contexted p wX)]
joinOverlapping [Component name prim wY]
done [Set name]
res
  go Set name
todo [Component name prim wY]
done [Set name]
res (RL (RepoPatchV3 name prim) wO wY
cs :<: RepoPatchV3 name prim wY wA
p) RL (RepoPatchV3 name prim) wA wB
NilRL FL (RepoPatchV3 name prim) wB wY
passedby
    | RepoPatchV3 name prim wY wA -> PatchId (RepoPatchV3 name prim)
forall wX wY.
RepoPatchV3 name prim wX wY -> PatchId (RepoPatchV3 name prim)
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RepoPatchV3 name prim wY wA
p name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set name
todo
    , Just (FL (RepoPatchV3 name prim) wY wZ
_ :> RepoPatchV3 name prim wZ wY
p') <- (:>) (RepoPatchV3 name prim) (FL (RepoPatchV3 name prim)) wY wY
-> Maybe
     ((:>) (FL (RepoPatchV3 name prim)) (RepoPatchV3 name prim) wY wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RepoPatchV3 name prim wY wA
p RepoPatchV3 name prim wY wA
-> FL (RepoPatchV3 name prim) wA wY
-> (:>) (RepoPatchV3 name prim) (FL (RepoPatchV3 name prim)) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RepoPatchV3 name prim) wA wY
FL (RepoPatchV3 name prim) wB wY
passedby) =
        Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wY
-> RL (RepoPatchV3 name prim) wY wY
-> FL (RepoPatchV3 name prim) wY wY
-> [Component name prim wY]
forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go (RepoPatchV3 name prim wY wA -> Set name -> Set name
forall {b} {prim :: * -> * -> *} {wX} {wY}.
SignedId b =>
RepoPatchV3 b prim wX wY -> Set b -> Set b
updTodo RepoPatchV3 name prim wY wA
p Set name
todo) (RepoPatchV3 name prim wZ wY
-> [Component name prim wY] -> [Component name prim wY]
forall {name} {prim :: * -> * -> *} {wX} {wY}.
SignedId name =>
RepoPatchV3 name prim wX wY
-> [Set (Contexted (PrimWithName name prim) wY)]
-> [Set (Contexted (PrimWithName name prim) wY)]
updDone RepoPatchV3 name prim wZ wY
p' [Component name prim wY]
done) [Set name]
res RL (RepoPatchV3 name prim) wO wY
cs RL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL (RepoPatchV3 name prim wY wA
p RepoPatchV3 name prim wY wA
-> FL (RepoPatchV3 name prim) wA wY
-> FL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV3 name prim) wA wY
FL (RepoPatchV3 name prim) wB wY
passedby)
    | Bool
otherwise =
        Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wY
-> RL (RepoPatchV3 name prim) wY wY
-> FL (RepoPatchV3 name prim) wY wY
-> [Component name prim wY]
forall wA wB.
Set name
-> [Component name prim wY]
-> [Set name]
-> RL (RepoPatchV3 name prim) wO wA
-> RL (RepoPatchV3 name prim) wA wB
-> FL (RepoPatchV3 name prim) wB wY
-> [Component name prim wY]
go (RepoPatchV3 name prim wY wA -> Set name -> Set name
forall {b} {prim :: * -> * -> *} {wX} {wY}.
SignedId b =>
RepoPatchV3 b prim wX wY -> Set b -> Set b
updTodo RepoPatchV3 name prim wY wA
p Set name
todo) [Component name prim wY]
done (RepoPatchV3 name prim wY wA -> [Set name] -> [Set name]
forall {b} {prim :: * -> * -> *} {wX} {wX}.
SignedId b =>
RepoPatchV3 b prim wX wX -> [Set b] -> [Set b]
updRes RepoPatchV3 name prim wY wA
p [Set name]
res) RL (RepoPatchV3 name prim) wO wY
cs RL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL (RepoPatchV3 name prim wY wA
p RepoPatchV3 name prim wY wA
-> FL (RepoPatchV3 name prim) wA wY
-> FL (RepoPatchV3 name prim) wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV3 name prim) wA wY
FL (RepoPatchV3 name prim) wB wY
passedby)
  go Set name
_ [Component name prim wY]
_ [Set name]
_ RL (RepoPatchV3 name prim) wO wA
NilRL RL (RepoPatchV3 name prim) wA wB
NilRL FL (RepoPatchV3 name prim) wB wY
_ = [Char] -> [Component name prim wY]
forall a. HasCallStack => [Char] -> a
error [Char]
"autsch, hit the bottom"

  updTodo :: RepoPatchV3 b prim wX wY -> Set b -> Set b
updTodo RepoPatchV3 b prim wX wY
p Set b
todo = (Contexted (PrimWithName b prim) wY -> b)
-> Set (Contexted (PrimWithName b prim) wY) -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Contexted (PrimWithName b prim) wY -> b
Contexted (PrimWithName b prim) wY -> PatchId (PrimWithName b prim)
forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId (RepoPatchV3 b prim wX wY
-> Set (Contexted (PrimWithName b prim) wY)
forall {name} {prim :: * -> * -> *} {wX} {wY}.
RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
conflicts RepoPatchV3 b prim wX wY
p) Set b -> Set b -> Set b
forall a. Semigroup a => a -> a -> a
<> (RepoPatchV3 b prim wX wY -> PatchId (RepoPatchV3 b prim)
forall wX wY.
RepoPatchV3 b prim wX wY -> PatchId (RepoPatchV3 b prim)
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RepoPatchV3 b prim wX wY
p b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
-| Set b
todo)
  updDone :: RepoPatchV3 name prim wX wY
-> [Set (Contexted (PrimWithName name prim) wY)]
-> [Set (Contexted (PrimWithName name prim) wY)]
updDone RepoPatchV3 name prim wX wY
p' [Set (Contexted (PrimWithName name prim) wY)]
done = Set (Contexted (PrimWithName name prim) wY)
-> [Set (Contexted (PrimWithName name prim) wY)]
-> [Set (Contexted (PrimWithName name prim) wY)]
forall a. Ord a => Set a -> [Set a] -> [Set a]
joinOrAddNew (RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
forall {name} {prim :: * -> * -> *} {wX} {wY}.
SignedId name =>
RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
allConflicts RepoPatchV3 name prim wX wY
p') [Set (Contexted (PrimWithName name prim) wY)]
done
  updRes :: RepoPatchV3 b prim wX wX -> [Set b] -> [Set b]
updRes RepoPatchV3 b prim wX wX
p [Set b]
res = (Contexted (PrimWithName b prim) wX -> b)
-> Set (Contexted (PrimWithName b prim) wX) -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Contexted (PrimWithName b prim) wX -> b
Contexted (PrimWithName b prim) wX -> PatchId (PrimWithName b prim)
forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId (RepoPatchV3 b prim wX wX
-> Set (Contexted (PrimWithName b prim) wX)
forall {name} {prim :: * -> * -> *} {wX} {wY}.
SignedId name =>
RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
allConflicts RepoPatchV3 b prim wX wX
p) Set b -> [Set b] -> [Set b]
forall a. a -> [a] -> [a]
: [Set b]
res

  conflicts :: RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
conflicts (Conflictor FL (PrimWithName name prim) wX wY
_ Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
_) = Set (Contexted (PrimWithName name prim) wY)
x
  conflicts RepoPatchV3 name prim wX wY
_ = Set (Contexted (PrimWithName name prim) wY)
forall a. Set a
S.empty

  allConflicts :: RepoPatchV3 name prim wX wY
-> Set (Contexted (PrimWithName name prim) wY)
allConflicts (Conflictor FL (PrimWithName name prim) wX wY
_ Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cp) = Contexted (PrimWithName name prim) wY
cp Contexted (PrimWithName name prim) wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Set (Contexted (PrimWithName name prim) wY)
forall a. Ord a => a -> Set a -> Set a
+| Set (Contexted (PrimWithName name prim) wY)
x
  allConflicts RepoPatchV3 name prim wX wY
_ = Set (Contexted (PrimWithName name prim) wY)
forall a. Set a
S.empty

  -- Join all components which overlap with the given set of IDs
  joinOverlapping :: Set (PatchId p) -> [Set (Contexted p wX)] -> [Set (Contexted p wX)]
joinOverlapping Set (PatchId p)
ids [Set (Contexted p wX)]
cs =
    case (Set (Contexted p wX) -> Bool)
-> [Set (Contexted p wX)]
-> ([Set (Contexted p wX)], [Set (Contexted p wX)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Bool
not (Bool -> Bool)
-> (Set (Contexted p wX) -> Bool) -> Set (Contexted p wX) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (PatchId p) -> Set (PatchId p) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set (PatchId p)
ids (Set (PatchId p) -> Bool)
-> (Set (Contexted p wX) -> Set (PatchId p))
-> Set (Contexted p wX)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Contexted p wX -> PatchId p)
-> Set (Contexted p wX) -> Set (PatchId p)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Contexted p wX -> PatchId p
forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId) [Set (Contexted p wX)]
cs of
      ([], [Set (Contexted p wX)]
to_keep) -> [Set (Contexted p wX)]
to_keep -- avoid adding empty components
      ([Set (Contexted p wX)]
to_join, [Set (Contexted p wX)]
to_keep) -> [Set (Contexted p wX)] -> Set (Contexted p wX)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Set (Contexted p wX)]
to_join Set (Contexted p wX)
-> [Set (Contexted p wX)] -> [Set (Contexted p wX)]
forall a. a -> [a] -> [a]
: [Set (Contexted p wX)]
to_keep

  -- remove vertices that others depend on
  purgeDeps :: Component name prim wY -> Component name prim wY
  purgeDeps :: Component name prim wY -> Component name prim wY
purgeDeps Component name prim wY
c = (Contexted (PrimWithName name prim) wY -> Bool)
-> Component name prim wY -> Component name prim wY
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Contexted (PrimWithName name prim) wY
a -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Contexted (PrimWithName name prim) wY -> Bool)
-> Component name prim wY -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Contexted (PrimWithName name prim) wY
a Contexted (PrimWithName name prim) wY
-> Contexted (PrimWithName name prim) wY -> Bool
forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> Contexted p wX -> Bool
`ctxDepends`) (Contexted (PrimWithName name prim) wY
a Contexted (PrimWithName name prim) wY
-> Component name prim wY -> Component name prim wY
forall a. Ord a => a -> Set a -> Set a
-| Component name prim wY
c)) Component name prim wY
c

-- | Add a set to a disjoint list of sets, such that we maintain the invariant
-- that the resulting list of sets is disjoint, and such that their unions are
-- equal to the unions of the inputs.
--
-- The tricky point here is that the new set may overlap with any number of
-- list elements; we must ensure they are all joined into a single set.
joinOrAddNew :: Ord a => S.Set a -> [S.Set a] -> [S.Set a]
joinOrAddNew :: forall a. Ord a => Set a -> [Set a] -> [Set a]
joinOrAddNew Set a
c [] = [Set a
c]
joinOrAddNew Set a
c (Set a
d:[Set a]
ds)
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Set a -> Bool) -> [Set a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set a
d) [Set a]
ds = [Char] -> [Set a]
forall a. HasCallStack => [Char] -> a
error [Char]
"precondition: sets are not disjoint"
  | Set a
c Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.disjoint` Set a
d = Set a
d Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: Set a -> [Set a] -> [Set a]
forall a. Ord a => Set a -> [Set a] -> [Set a]
joinOrAddNew Set a
c [Set a]
ds
  | Bool
otherwise = Set a -> [Set a] -> [Set a]
forall a. Ord a => Set a -> [Set a] -> [Set a]
joinOrAddNew (Set a
c Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
d) [Set a]
ds