module Darcs.Patch.Conflict
( Conflict(..)
, ConflictDetails(..)
, Mangled
, Unravelled
, mangleOrFail
, combineConflicts
) where
import Darcs.Prelude
import Darcs.Patch.CommuteFn ( commuterIdFL )
import Darcs.Patch.CommuteNoConflicts ( CommuteNoConflicts(..) )
import Darcs.Patch.Permutations ()
import Darcs.Patch.FromPrim ( PrimOf )
import Darcs.Patch.Prim ( PrimMangleUnravelled(..), Mangled, Unravelled )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), (:>)(..) )
data ConflictDetails prim wX =
ConflictDetails {
ConflictDetails prim wX -> Maybe (Mangled prim wX)
conflictMangled :: Maybe (Mangled prim wX),
ConflictDetails prim wX -> Unravelled prim wX
conflictParts :: Unravelled prim wX
}
mangleOrFail :: PrimMangleUnravelled prim
=> Unravelled prim wX -> ConflictDetails prim wX
mangleOrFail :: Unravelled prim wX -> ConflictDetails prim wX
mangleOrFail Unravelled prim wX
parts =
ConflictDetails :: forall (prim :: * -> * -> *) wX.
Maybe (Mangled prim wX)
-> Unravelled prim wX -> ConflictDetails prim wX
ConflictDetails {
conflictMangled :: Maybe (Mangled prim wX)
conflictMangled = Unravelled prim wX -> Maybe (Mangled prim wX)
forall (prim :: * -> * -> *) wX.
PrimMangleUnravelled prim =>
Unravelled prim wX -> Maybe (Mangled prim wX)
mangleUnravelled Unravelled prim wX
parts,
conflictParts :: Unravelled prim wX
conflictParts = Unravelled prim wX
parts
}
class Conflict p where
resolveConflicts :: RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
combineConflicts
:: forall p wX wY. CommuteNoConflicts p
=> (forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB])
-> RL p wX wY -> [Unravelled (PrimOf p) wY]
combineConflicts :: (forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB])
-> RL p wX wY -> [Unravelled (PrimOf p) wY]
combineConflicts forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB]
resolveOne RL p wX wY
x = RL p wX wY -> FL p wY wY -> [Unravelled (PrimOf p) wY]
forall wM. RL p wX wM -> FL p wM wY -> [Unravelled (PrimOf p) wY]
rcs RL p wX wY
x FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
where
rcs :: RL p wX wM -> FL p wM wY -> [Unravelled (PrimOf p) wY]
rcs :: RL p wX wM -> FL p wM wY -> [Unravelled (PrimOf p) wY]
rcs RL p wX wM
NilRL FL p wM wY
_ = []
rcs (RL p wX wY
ps :<: p wY wM
p) FL p wM wY
passedby
| [Unravelled (PrimOf p) wM] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (p wY wM -> [Unravelled (PrimOf p) wM]
forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB]
resolveOne p wY wM
p) = FL p wM wY
-> [Unravelled (PrimOf p) wY] -> [Unravelled (PrimOf p) wY]
seq FL p wM wY
passedby [Unravelled (PrimOf p) wY]
rest
| Bool
otherwise =
case CommuteFn p p -> (:>) p (FL p) wY wY -> Maybe ((:>) (FL p) p wY wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn p p
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commuteNoConflicts (p wY wM
p p wY wM -> FL p wM wY -> (:>) p (FL p) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wM wY
passedby) of
Just (FL p wY wZ
_ :> p wZ wY
p') -> p wZ wY -> [Unravelled (PrimOf p) wY]
forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB]
resolveOne p wZ wY
p' [Unravelled (PrimOf p) wY]
-> [Unravelled (PrimOf p) wY] -> [Unravelled (PrimOf p) wY]
forall a. [a] -> [a] -> [a]
++ [Unravelled (PrimOf p) wY]
rest
Maybe ((:>) (FL p) p wY wY)
Nothing -> [Unravelled (PrimOf p) wY]
rest
where
rest :: [Unravelled (PrimOf p) wY]
rest = RL p wX wY -> FL p wY wY -> [Unravelled (PrimOf p) wY]
forall wM. RL p wX wM -> FL p wM wY -> [Unravelled (PrimOf p) wY]
rcs RL p wX wY
ps (p wY wM
p p wY wM -> FL p wM wY -> FL p wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wM wY
passedby)