{-# 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 )
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
type Component name prim wY = S.Set (Contexted (PrimWithName 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 :: 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
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
([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
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
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