{-# LANGUAGE ViewPatterns, PatternSynonyms #-}
module Darcs.Patch.V3.Core
( RepoPatchV3(..)
, pattern PrimP
, pattern ConflictorP
, (+|)
, (-|)
) where
import Control.Applicative ( Alternative(..) )
import Control.Monad ( guard )
import qualified Data.ByteString.Char8 as BC
import Data.List.Ordered ( nubSort )
import qualified Data.Set as S
import Darcs.Prelude
import Darcs.Patch.Commute ( commuteFL, commuteRL, commuteRLFL )
import Darcs.Patch.CommuteFn ( CommuteFn )
import Darcs.Patch.CommuteNoConflicts ( CommuteNoConflicts(..) )
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( ListFormat(ListFormatV3) )
import Darcs.Patch.FromPrim ( ToPrim(..) )
import Darcs.Patch.Ident
( Ident(..)
, IdEq2(..)
, PatchId
, SignedId(..)
, StorableId(..)
, commuteToPrefix
, fastRemoveFL
, findCommonFL
)
import Darcs.Patch.Invert ( Invert, invert, invertFL )
import Darcs.Patch.Merge
( CleanMerge(..)
, Merge(..)
, cleanMergeFL
, swapCleanMerge
, swapMerge
)
import Darcs.Patch.Prim ( PrimPatch, applyPrimFL )
import Darcs.Patch.Prim.WithName ( PrimWithName, wnPatch )
import Darcs.Patch.Read ( bracketedFL )
import Darcs.Patch.Repair (RepairToFL(..), Check(..) )
import Darcs.Patch.RepoPatch
( Apply(..)
, Commute(..)
, Effect(..)
, Eq2(..)
, PatchInspect(..)
, PatchListFormat(..)
, PrimPatchBase(..)
, ReadPatch(..)
, Summary(..)
)
import Darcs.Patch.Show hiding ( displayPatch )
import Darcs.Patch.Summary
( ConflictState(..)
, IsConflictedPrim(..)
, plainSummary
, plainSummaryFL
)
import Darcs.Patch.Unwind ( Unwind(..), mkUnwound )
import Darcs.Patch.V3.Contexted
( Contexted
, ctxId
, ctxView
, ctxNoConflict
, ctx
, ctxAddRL
, ctxAddInvFL
, ctxAddFL
, commutePast
, commutePastRL
, ctxTouches
, ctxHunkMatches
, showCtx
, readCtx
)
import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
( (:/\:)(..)
, (:>)(..)
, (:\/:)(..)
, FL(..)
, Fork(..)
, (+>+)
, mapFL
, mapFL_FL
, reverseFL
, reverseRL
)
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP1 )
import Darcs.Test.TestOnly
import Darcs.Util.Parser ( string, lexString, choice, skipSpace )
import Darcs.Util.Printer
( Doc
, ($$)
, (<+>)
, blueText
, redText
, renderString
, vcat
)
data RepoPatchV3 name prim wX wY where
Prim :: PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Conflictor :: FL (PrimWithName name prim) wX wY
-> S.Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
pattern PrimP :: TestOnly => PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
pattern $mPrimP :: forall {r} {name} {prim :: * -> * -> *} {wX} {wY}.
TestOnly =>
RepoPatchV3 name prim wX wY
-> (PrimWithName name prim wX wY -> r) -> ((# #) -> r) -> r
PrimP prim <- Prim prim
pattern ConflictorP
:: TestOnly
=> FL (PrimWithName name prim) wX wY
-> S.Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
pattern $mConflictorP :: forall {r} {name} {prim :: * -> * -> *} {wX} {wY}.
TestOnly =>
RepoPatchV3 name prim wX wY
-> (FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> r)
-> ((# #) -> r)
-> r
ConflictorP r x cp <- Conflictor r x cp
instance Effect (RepoPatchV3 name prim) where
effect :: forall wX wY.
RepoPatchV3 name prim wX wY
-> FL (PrimOf (RepoPatchV3 name prim)) wX wY
effect (Prim PrimWithName name prim wX wY
p) = forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch PrimWithName name prim wX wY
p forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
effect (Conflictor FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
_ Contexted (PrimWithName name prim) wY
_) = forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch FL (PrimWithName name prim) wX wY
r
type instance PatchId (RepoPatchV3 name prim) = name
instance SignedId name => Ident (RepoPatchV3 name prim) where
ident :: forall wX wY.
RepoPatchV3 name prim wX wY -> PatchId (RepoPatchV3 name prim)
ident (Prim PrimWithName name prim wX wY
p) = forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident PrimWithName name prim wX wY
p
ident (Conflictor FL (PrimWithName name prim) wX wY
_ Set (Contexted (PrimWithName name prim) wY)
_ Contexted (PrimWithName name prim) wY
cp) = forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId Contexted (PrimWithName name prim) wY
cp
displayPatch :: ShowPatchBasic p => p wX wY -> Doc
displayPatch :: forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch p wX wY
p = forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage p wX wY
p
instance (SignedId name, StorableId name, PrimPatch prim) =>
CleanMerge (RepoPatchV3 name prim) where
cleanMerge :: forall wX wY.
(:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> Maybe
((:/\:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY)
cleanMerge (RepoPatchV3 name prim wZ wX
p :\/: RepoPatchV3 name prim wZ wY
q)
| forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RepoPatchV3 name prim wZ wX
p forall a. Eq a => a -> a -> Bool
== forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RepoPatchV3 name prim wZ wY
q = forall a. HasCallStack => [Char] -> a
error [Char]
"merging identical patches is undefined"
cleanMerge (Prim PrimWithName name prim wZ wX
p :\/: Prim PrimWithName name prim wZ wY
q) = do
PrimWithName name prim wX wZ
q' :/\: PrimWithName name prim wY wZ
p' <- forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (PrimWithName name prim wZ wX
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: PrimWithName name prim wZ wY
q)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wX wZ
q' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wY wZ
p'
cleanMerge (Prim PrimWithName name prim wZ wX
p :\/: Conflictor FL (PrimWithName name prim) wZ wY
s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq) = do
FL (PrimWithName name prim) wX wZ
s' :/\: PrimWithName name prim wY wZ
p' <- forall (p :: * -> * -> *). CleanMerge p => PartialMergeFn p (FL p)
cleanMergeFL (PrimWithName name prim wZ wX
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimWithName name prim) wZ wY
s)
let ip' :: PrimWithName name prim wZ wY
ip' = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wY wZ
p'
Contexted (PrimWithName name prim) wZ
cq' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wZ wY
ip' Contexted (PrimWithName name prim) wY
cq
Set (Contexted (PrimWithName name prim) wZ)
y' <- forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wZ wY
ip') (forall a. Set a -> [a]
S.toList Set (Contexted (PrimWithName name prim) wY)
y)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wZ
s' Set (Contexted (PrimWithName name prim) wZ)
y' Contexted (PrimWithName name prim) wZ
cq' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wY wZ
p'
cleanMerge pair :: (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair@(Conflictor {} :\/: Prim {}) = forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
swapCleanMerge (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair
cleanMerge (Conflictor FL (PrimWithName name prim) wZ wX
com_r Set (Contexted (PrimWithName name prim) wX)
x Contexted (PrimWithName name prim) wX
cp :\/: Conflictor FL (PrimWithName name prim) wZ wY
com_s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq) =
case forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
FL p wX wY -> FL p wX wZ -> Fork (FL p) (FL p) (FL p) wX wY wZ
findCommonFL FL (PrimWithName name prim) wZ wX
com_r FL (PrimWithName name prim) wZ wY
com_s of
Fork FL (PrimWithName name prim) wZ wU
_ FL (PrimWithName name prim) wU wX
rev_r FL (PrimWithName name prim) wU wY
rev_s -> do
FL (PrimWithName name prim) wX wZ
s' :/\: FL (PrimWithName name prim) wY wZ
r' <- forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL (PrimWithName name prim) wU wX
rev_r forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimWithName name prim) wU wY
rev_s)
let cp' :: Contexted (PrimWithName name prim) wZ
cp' = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wX wZ
s' Contexted (PrimWithName name prim) wX
cp
let cq' :: Contexted (PrimWithName name prim) wZ
cq' = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wY wZ
r' Contexted (PrimWithName name prim) wY
cq
let x' :: Set (Contexted (PrimWithName name prim) wZ)
x' = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wX wZ
s') Set (Contexted (PrimWithName name prim) wX)
x
let y' :: Set (Contexted (PrimWithName name prim) wZ)
y' = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wY wZ
r') Set (Contexted (PrimWithName name prim) wY)
y
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
cq' Contexted (PrimWithName name prim) wZ
cp')
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
cq') (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set (Contexted (PrimWithName name prim) wZ)
x' Set (Contexted (PrimWithName name prim) wZ)
y')
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
cp') (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set (Contexted (PrimWithName name prim) wZ)
y' Set (Contexted (PrimWithName name prim) wZ)
x')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wZ
s' Set (Contexted (PrimWithName name prim) wZ)
y' Contexted (PrimWithName name prim) wZ
cq' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wY wZ
r' Set (Contexted (PrimWithName name prim) wZ)
x' Contexted (PrimWithName name prim) wZ
cp'
instance (SignedId name, StorableId name, PrimPatch prim) =>
Merge (RepoPatchV3 name prim) where
merge :: forall wX wY.
(:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> (:/\:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
merge (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pq | Just (:/\:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
r <- forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pq = (:/\:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
r
merge (Prim PrimWithName name prim wZ wX
p :\/: Prim PrimWithName name prim wZ wY
q) =
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wX
p forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (forall a. a -> Set a
S.singleton (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wX
p)) (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wY
q)
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\:
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wY
q forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (forall a. a -> Set a
S.singleton (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wY
q)) (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wX
p)
merge (Prim PrimWithName name prim wZ wX
p :\/: Conflictor FL (PrimWithName name prim) wZ wY
r Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cq) =
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wX
p forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: FL (PrimWithName name prim) wZ wY
r) (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wZ wY
r (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wX
p) forall a. Ord a => a -> Set a -> Set a
+| Set (Contexted (PrimWithName name prim) wY)
x) Contexted (PrimWithName name prim) wY
cq
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\:
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (forall a. a -> Set a
S.singleton Contexted (PrimWithName name prim) wY
cq) (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wZ wY
r (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wZ wX
p))
merge pair :: (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair@(Conflictor {} :\/: Prim {}) = forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
swapMerge (:\/:) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair
merge (lhs :: RepoPatchV3 name prim wZ wX
lhs@(Conflictor FL (PrimWithName name prim) wZ wX
com_r Set (Contexted (PrimWithName name prim) wX)
x Contexted (PrimWithName name prim) wX
cp) :\/: rhs :: RepoPatchV3 name prim wZ wY
rhs@(Conflictor FL (PrimWithName name prim) wZ wY
com_s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq)) =
case forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
FL p wX wY -> FL p wX wZ -> Fork (FL p) (FL p) (FL p) wX wY wZ
findCommonFL FL (PrimWithName name prim) wZ wX
com_r FL (PrimWithName name prim) wZ wY
com_s of
Fork FL (PrimWithName name prim) wZ wU
_ FL (PrimWithName name prim) wU wX
r FL (PrimWithName name prim) wU wY
s ->
case forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL (PrimWithName name prim) wU wX
r forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimWithName name prim) wU wY
s) of
Just (FL (PrimWithName name prim) wX wZ
s' :/\: FL (PrimWithName name prim) wY wZ
r') ->
let cp' :: Contexted (PrimWithName name prim) wZ
cp' = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wX wZ
s' Contexted (PrimWithName name prim) wX
cp
cq' :: Contexted (PrimWithName name prim) wZ
cq' = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wY wZ
r' Contexted (PrimWithName name prim) wY
cq
x' :: Set (Contexted (PrimWithName name prim) wZ)
x' = Contexted (PrimWithName name prim) wZ
cq' forall a. Ord a => a -> Set a -> Set a
+| forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wX wZ
s') Set (Contexted (PrimWithName name prim) wX)
x
y' :: Set (Contexted (PrimWithName name prim) wZ)
y' = Contexted (PrimWithName name prim) wZ
cp' forall a. Ord a => a -> Set a -> Set a
+| forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wY wZ
r') Set (Contexted (PrimWithName name prim) wY)
y
in forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wZ
s' Set (Contexted (PrimWithName name prim) wZ)
y' Contexted (PrimWithName name prim) wZ
cq' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wY wZ
r' Set (Contexted (PrimWithName name prim) wZ)
x' Contexted (PrimWithName name prim) wZ
cp'
Maybe
((:/\:)
(FL (PrimWithName name prim)) (FL (PrimWithName name prim)) wX wY)
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"uncommon effects can't be merged cleanly:"
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"lhs:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV3 name prim wZ wX
lhs
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"rhs:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV3 name prim wZ wY
rhs
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"r:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimWithName name prim) wU wX
r
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"s:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimWithName name prim) wU wY
s
instance (SignedId name, StorableId name, PrimPatch prim)
=> CommuteNoConflicts (RepoPatchV3 name prim) where
commuteNoConflicts :: forall wX wY.
(:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> Maybe
((:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY)
commuteNoConflicts (Prim PrimWithName name prim wX wZ
p :> Prim PrimWithName name prim wZ wY
q)
| Just (PrimWithName name prim wX wZ
q' :> PrimWithName name prim wZ wY
p') <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (PrimWithName name prim wX wZ
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimWithName name prim wZ wY
q) = forall a. a -> Maybe a
Just (forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wX wZ
q' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wZ wY
p')
commuteNoConflicts (Conflictor FL (PrimWithName name prim) wX wZ
r Set (Contexted (PrimWithName name prim) wZ)
x Contexted (PrimWithName name prim) wZ
cp :> Prim PrimWithName name prim wZ wY
q)
| Just (PrimWithName name prim wX wZ
q' :> RL (PrimWithName name prim) wZ wY
r') <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PrimWithName name prim) wX wZ
r forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimWithName name prim wZ wY
q)
, let iq :: PrimWithName name prim wY wZ
iq = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wY
q
, Just Contexted (PrimWithName name prim) wY
cp' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wY wZ
iq Contexted (PrimWithName name prim) wZ
cp
, Just Set (Contexted (PrimWithName name prim) wY)
x' <- forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wY wZ
iq) (forall a. Set a -> [a]
S.toList Set (Contexted (PrimWithName name prim) wZ)
x) =
forall a. a -> Maybe a
Just (forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wX wZ
q' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimWithName name prim) wZ wY
r') Set (Contexted (PrimWithName name prim) wY)
x' Contexted (PrimWithName name prim) wY
cp')
commuteNoConflicts (Prim PrimWithName name prim wX wZ
p :> Conflictor FL (PrimWithName name prim) wZ wY
s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq)
| Just (FL (PrimWithName name prim) wX wZ
s' :> PrimWithName name prim wZ wY
p') <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (PrimWithName name prim wX wZ
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimWithName name prim) wZ wY
s)
, Just Contexted (PrimWithName name prim) wZ
cq' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wZ wY
p' Contexted (PrimWithName name prim) wY
cq
, Just Set (Contexted (PrimWithName name prim) wZ)
y' <- forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (p :: * -> * -> *) wX wY.
Commute p =>
p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePast PrimWithName name prim wZ wY
p') (forall a. Set a -> [a]
S.toList Set (Contexted (PrimWithName name prim) wY)
y) =
forall a. a -> Maybe a
Just (forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wZ
s' Set (Contexted (PrimWithName name prim) wZ)
y' Contexted (PrimWithName name prim) wZ
cq' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wZ wY
p')
commuteNoConflicts (Conflictor FL (PrimWithName name prim) wX wZ
com_r Set (Contexted (PrimWithName name prim) wZ)
x Contexted (PrimWithName name prim) wZ
cp :> Conflictor FL (PrimWithName name prim) wZ wY
s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq) = do
FL (PrimWithName name prim) wX wZ
com :> RL (PrimWithName name prim) wZ wZ
rr <- forall (p :: * -> * -> *) wX wY.
(Commute p, Ident p) =>
Set (PatchId p) -> FL p wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteToPrefix (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. SignedId a => a -> a
invertId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId) Set (Contexted (PrimWithName name prim) wY)
y) FL (PrimWithName name prim) wX wZ
com_r
FL (PrimWithName name prim) wZ wZ
s' :> RL (PrimWithName name prim) wZ wY
rr' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteRLFL (RL (PrimWithName name prim) wZ wZ
rr forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimWithName name prim) wZ wY
s)
Contexted (PrimWithName name prim) wY
cp' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePastRL (forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL (PrimWithName name prim) wZ wY
s) Contexted (PrimWithName name prim) wZ
cp
Contexted (PrimWithName name prim) wZ
cq' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> Contexted p wY -> Maybe (Contexted p wX)
commutePastRL RL (PrimWithName name prim) wZ wY
rr' Contexted (PrimWithName name prim) wY
cq
let sq :: Contexted (PrimWithName name prim) wZ
sq = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddFL FL (PrimWithName name prim) wZ wY
s Contexted (PrimWithName name prim) wY
cq
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
sq Contexted (PrimWithName name prim) wZ
cp)
let sy :: Set (Contexted (PrimWithName name prim) wZ)
sy = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddFL FL (PrimWithName name prim) wZ wY
s) Set (Contexted (PrimWithName name prim) wY)
y
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
sq) (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set (Contexted (PrimWithName name prim) wZ)
x Set (Contexted (PrimWithName name prim) wZ)
sy)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (p :: * -> * -> *) wX.
(CleanMerge p, Commute p, Ident p) =>
Contexted p wX -> Contexted p wX -> Bool
ctxNoConflict Contexted (PrimWithName name prim) wZ
cp) (forall a. Ord a => Set a -> Set a -> Set a
S.difference Set (Contexted (PrimWithName name prim) wZ)
sy Set (Contexted (PrimWithName name prim) wZ)
x)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (FL (PrimWithName name prim) wX wZ
com forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimWithName name prim) wZ wZ
s') (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
RL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddRL RL (PrimWithName name prim) wZ wY
rr') Set (Contexted (PrimWithName name prim) wY)
y) Contexted (PrimWithName name prim) wZ
cq'
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimWithName name prim) wZ wY
rr') (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wZ wY
s) Set (Contexted (PrimWithName name prim) wZ)
x) Contexted (PrimWithName name prim) wY
cp'
commuteNoConflicts (:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
_ = forall a. Maybe a
Nothing
commuteConflicting
:: (SignedId name, StorableId name, PrimPatch prim)
=> CommuteFn (RepoPatchV3 name prim) (RepoPatchV3 name prim)
commuteConflicting :: forall name (prim :: * -> * -> *) wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
(:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> Maybe
((:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY)
commuteConflicting (Prim PrimWithName name prim wX wZ
p :> Conflictor (PrimWithName name prim wZ wY
ip:>:FL (PrimWithName name prim) wY wY
NilFL) Set (Contexted (PrimWithName name prim) wY)
ys cq :: Contexted (PrimWithName name prim) wY
cq@(forall (p :: * -> * -> *) wX.
Contexted p wX -> Sealed ((:>) (FL p) p wX)
ctxView -> Sealed (FL (PrimWithName name prim) wY wZ
NilFL :> PrimWithName name prim wZ wX
q)))
| [forall (p :: * -> * -> *) wX.
Contexted p wX -> Sealed ((:>) (FL p) p wX)
ctxView -> Sealed (FL (PrimWithName name prim) wY wZ
NilFL :> PrimWithName name prim wZ wX
p')] <- forall a. Set a -> [a]
S.toList Set (Contexted (PrimWithName name prim) wY)
ys
, EqCheck wX wY
IsEq <- forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wX wZ
p forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= PrimWithName name prim wZ wY
ip
, EqCheck wZ wX
IsEq <- PrimWithName name prim wX wZ
p forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= PrimWithName name prim wZ wX
p' =
forall a. a -> Maybe a
Just (forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wZ wX
q forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wX
q forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (forall a. a -> Set a
S.singleton Contexted (PrimWithName name prim) wY
cq) (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wX wZ
p))
commuteConflicting (Prim PrimWithName name prim wX wZ
p :> Conflictor FL (PrimWithName name prim) wZ wY
s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq)
| forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident PrimWithName name prim wX wZ
p forall a. Ord a => a -> Set a -> Bool
`S.member` forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId Set (Contexted (PrimWithName name prim) wY)
y =
case forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
p wX wY -> FL p wX wZ -> Maybe (FL p wY wZ)
fastRemoveFL (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wX wZ
p) FL (PrimWithName name prim) wZ wY
s of
Maybe (FL (PrimWithName name prim) wX wY)
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"commuteConflicting: cannot remove (invert lhs):"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wX wZ
p)
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"from effect of rhs:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimWithName name prim) wZ wY
s
Just FL (PrimWithName name prim) wX wY
r ->
let cp :: Contexted (PrimWithName name prim) wY
cp = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wX wY
r (forall (p :: * -> * -> *) wX wY. p wX wY -> Contexted p wX
ctx PrimWithName name prim wX wZ
p)
in forall a. a -> Maybe a
Just (forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wY
r (Contexted (PrimWithName name prim) wY
cp forall a. Ord a => a -> Set a -> Set a
-| Set (Contexted (PrimWithName name prim) wY)
y) Contexted (PrimWithName name prim) wY
cq forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (forall a. a -> Set a
S.singleton Contexted (PrimWithName name prim) wY
cq) Contexted (PrimWithName name prim) wY
cp)
commuteConflicting (lhs :: RepoPatchV3 name prim wX wZ
lhs@(Conflictor FL (PrimWithName name prim) wX wZ
r Set (Contexted (PrimWithName name prim) wZ)
x Contexted (PrimWithName name prim) wZ
cp) :> rhs :: RepoPatchV3 name prim wZ wY
rhs@(Conflictor FL (PrimWithName name prim) wZ wY
NilFL Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq))
| Set (Contexted (PrimWithName name prim) wY)
y forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
S.singleton Contexted (PrimWithName name prim) wZ
cp =
case forall (p :: * -> * -> *) wX.
Contexted p wX -> Sealed ((:>) (FL p) p wX)
ctxView (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddFL FL (PrimWithName name prim) wX wZ
r Contexted (PrimWithName name prim) wY
cq) of
Sealed (FL (PrimWithName name prim) wX wZ
NilFL :> PrimWithName name prim wZ wX
cq') ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim PrimWithName name prim wZ wX
cq'
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimWithName name prim wZ wX
cq' forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: FL (PrimWithName name prim) wX wZ
r) (Contexted (PrimWithName name prim) wY
cq forall a. Ord a => a -> Set a -> Set a
+| Set (Contexted (PrimWithName name prim) wZ)
x) Contexted (PrimWithName name prim) wZ
cp
Sealed (FL (PrimWithName name prim) wX wZ
c' :> PrimWithName name prim wZ wX
_) ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
redText [Char]
"remaining context in commute:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimWithName name prim) wX wZ
c'
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"lhs:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV3 name prim wX wZ
lhs
Doc -> Doc -> Doc
$$ [Char] -> Doc
redText [Char]
"rhs:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV3 name prim wZ wY
rhs
commuteConflicting (Conflictor FL (PrimWithName name prim) wX wZ
com_r Set (Contexted (PrimWithName name prim) wZ)
x Contexted (PrimWithName name prim) wZ
cp :> Conflictor FL (PrimWithName name prim) wZ wY
s Set (Contexted (PrimWithName name prim) wY)
y Contexted (PrimWithName name prim) wY
cq)
| let is_cp :: Contexted (PrimWithName name prim) wY
is_cp = forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wZ wY
s Contexted (PrimWithName name prim) wZ
cp
, Contexted (PrimWithName name prim) wY
is_cp forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Contexted (PrimWithName name prim) wY)
y
, let y' :: Set (Contexted (PrimWithName name prim) wY)
y' = Contexted (PrimWithName name prim) wY
is_cp forall a. Ord a => a -> Set a -> Set a
-| Set (Contexted (PrimWithName name prim) wY)
y =
case forall (p :: * -> * -> *) wX wY.
(Commute p, Ident p) =>
Set (PatchId p) -> FL p wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteToPrefix (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. SignedId a => a -> a
invertId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX.
Ident p =>
Contexted p wX -> PatchId p
ctxId) Set (Contexted (PrimWithName name prim) wY)
y') FL (PrimWithName name prim) wX wZ
com_r of
Maybe
((:>)
(FL (PrimWithName name prim)) (RL (PrimWithName name prim)) wX wZ)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"commuteConflicting: cannot commute common effects"
Just (FL (PrimWithName name prim) wX wZ
com :> RL (PrimWithName name prim) wZ wZ
rr) ->
case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) (FL p) wX wY -> Maybe ((:>) (FL p) (RL p) wX wY)
commuteRLFL (RL (PrimWithName name prim) wZ wZ
rr forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimWithName name prim) wZ wY
s) of
Maybe
((:>)
(FL (PrimWithName name prim)) (RL (PrimWithName name prim)) wZ wY)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"commuteConflicting: cannot commute uncommon effects"
Just (FL (PrimWithName name prim) wZ wZ
s' :> RL (PrimWithName name prim) wZ wY
rr') ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (FL (PrimWithName name prim) wX wZ
com forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimWithName name prim) wZ wZ
s')
(forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
RL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddRL RL (PrimWithName name prim) wZ wY
rr') Set (Contexted (PrimWithName name prim) wY)
y')
(forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
RL p wX wY -> Contexted p wY -> Contexted p wX
ctxAddRL RL (PrimWithName name prim) wZ wY
rr' Contexted (PrimWithName name prim) wY
cq)
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimWithName name prim) wZ wY
rr')
(Contexted (PrimWithName name prim) wY
cq forall a. Ord a => a -> Set a -> Set a
+| forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Ident p) =>
FL p wX wY -> Contexted p wX -> Contexted p wY
ctxAddInvFL FL (PrimWithName name prim) wZ wY
s) Set (Contexted (PrimWithName name prim) wZ)
x)
Contexted (PrimWithName name prim) wY
is_cp
commuteConflicting (:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
_ = forall a. Maybe a
Nothing
instance (SignedId name, StorableId name, PrimPatch prim) =>
Commute (RepoPatchV3 name prim) where
commute :: forall wX wY.
(:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> Maybe
((:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY)
commute (:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair = forall name (prim :: * -> * -> *) wX wY.
(SignedId name, StorableId name, PrimPatch prim) =>
(:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
-> Maybe
((:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY)
commuteConflicting (:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commuteNoConflicts (:>) (RepoPatchV3 name prim) (RepoPatchV3 name prim) wX wY
pair
instance PatchInspect prim => PatchInspect (RepoPatchV3 name prim) where
listTouchedFiles :: forall wX wY. RepoPatchV3 name prim wX wY -> [AnchoredPath]
listTouchedFiles (Prim PrimWithName name prim wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles PrimWithName name prim wX wY
p
listTouchedFiles (Conflictor FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
_ Contexted (PrimWithName name prim) wY
cp) =
forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PrimWithName name prim) wX wY
r) forall a. [a] -> [a] -> [a]
++ forall (p :: * -> * -> *) wX.
PatchInspect p =>
Contexted p wX -> [AnchoredPath]
ctxTouches Contexted (PrimWithName name prim) wY
cp
hunkMatches :: forall wX wY.
(ByteString -> Bool) -> RepoPatchV3 name prim wX wY -> Bool
hunkMatches ByteString -> Bool
f (Prim PrimWithName name prim wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f PrimWithName name prim wX wY
p
hunkMatches ByteString -> Bool
f (Conflictor FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
_ Contexted (PrimWithName name prim) wY
cp) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL (PrimWithName name prim) wX wY
r Bool -> Bool -> Bool
|| forall (p :: * -> * -> *) wX.
PatchInspect p =>
(ByteString -> Bool) -> Contexted p wX -> Bool
ctxHunkMatches ByteString -> Bool
f Contexted (PrimWithName name prim) wY
cp
instance (SignedId name, Eq2 prim, Commute prim) => Eq2 (RepoPatchV3 name prim) where
(Prim PrimWithName name prim wA wB
p) =\/= :: forall wA wB wC.
RepoPatchV3 name prim wA wB
-> RepoPatchV3 name prim wA wC -> EqCheck wB wC
=\/= (Prim PrimWithName name prim wA wC
q) = PrimWithName name prim wA wB
p forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= PrimWithName name prim wA wC
q
(Conflictor FL (PrimWithName name prim) wA wB
r Set (Contexted (PrimWithName name prim) wB)
x Contexted (PrimWithName name prim) wB
cp) =\/= (Conflictor FL (PrimWithName name prim) wA wC
s Set (Contexted (PrimWithName name prim) wC)
y Contexted (PrimWithName name prim) wC
cq)
| EqCheck wB wC
IsEq <- FL (PrimWithName name prim) wA wB
r forall (p :: * -> * -> *) wA wB wC.
IdEq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\^/= FL (PrimWithName name prim) wA wC
s
, Set (Contexted (PrimWithName name prim) wB)
x forall a. Eq a => a -> a -> Bool
== Set (Contexted (PrimWithName name prim) wC)
y
, Contexted (PrimWithName name prim) wB
cp forall a. Eq a => a -> a -> Bool
== Contexted (PrimWithName name prim) wC
cq = forall wA. EqCheck wA wA
IsEq
RepoPatchV3 name prim wA wB
_ =\/= RepoPatchV3 name prim wA wC
_ = forall wA wB. EqCheck wA wB
NotEq
instance (Show name, Show2 prim) => Show (RepoPatchV3 name prim wX wY) where
showsPrec :: Int -> RepoPatchV3 name prim wX wY -> ShowS
showsPrec Int
d RepoPatchV3 name prim wX wY
rp = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$
case RepoPatchV3 name prim wX wY
rp of
Prim PrimWithName name prim wX wY
prim ->
[Char] -> ShowS
showString [Char]
"Prim " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec forall a. Num a => a -> a -> a
+ Int
1) PrimWithName name prim wX wY
prim
Conflictor FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cp -> [Char] -> ShowS
showString [Char]
"Conflictor " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> ShowS
showContent FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cp
where
showContent :: a -> a -> a -> ShowS
showContent a
r a
x a
cp =
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec forall a. Num a => a -> a -> a
+ Int
1) a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> ShowS
showString [Char]
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec forall a. Num a => a -> a -> a
+ Int
1) a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> ShowS
showString [Char]
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec forall a. Num a => a -> a -> a
+ Int
1) a
cp
instance (Show name, Show2 prim) => Show1 (RepoPatchV3 name prim wX)
instance (Show name, Show2 prim) => Show2 (RepoPatchV3 name prim)
instance PrimPatch prim => PrimPatchBase (RepoPatchV3 name prim) where
type PrimOf (RepoPatchV3 name prim) = prim
instance ToPrim (RepoPatchV3 name prim) where
toPrim :: forall wX wY.
RepoPatchV3 name prim wX wY
-> Maybe (PrimOf (RepoPatchV3 name prim) wX wY)
toPrim (Conflictor {}) = forall a. Maybe a
Nothing
toPrim (Prim PrimWithName name prim wX wY
p) = forall a. a -> Maybe a
Just (forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch PrimWithName name prim wX wY
p)
instance PatchDebug prim => PatchDebug (RepoPatchV3 name prim)
instance PrimPatch prim => Apply (RepoPatchV3 name prim) where
type ApplyState (RepoPatchV3 name prim) = ApplyState prim
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RepoPatchV3 name prim)) m =>
RepoPatchV3 name prim wX wY -> m ()
apply = forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RepoPatchV3 name prim)) m =>
RepoPatchV3 name prim wX wY -> m ()
unapply = forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect
instance PatchListFormat (RepoPatchV3 name prim) where
patchListFormat :: ListFormat (RepoPatchV3 name prim)
patchListFormat = forall (p :: * -> * -> *). ListFormat p
ListFormatV3
instance IsHunk prim => IsHunk (RepoPatchV3 name prim) where
isHunk :: forall wX wY. RepoPatchV3 name prim wX wY -> Maybe (FileHunk wX wY)
isHunk RepoPatchV3 name prim wX wY
rp = do
Prim PrimWithName name prim wX wY
p <- forall (m :: * -> *) a. Monad m => a -> m a
return RepoPatchV3 name prim wX wY
rp
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk PrimWithName name prim wX wY
p
instance Summary (RepoPatchV3 name prim) where
conflictedEffect :: forall wX wY.
RepoPatchV3 name prim wX wY
-> [IsConflictedPrim (PrimOf (RepoPatchV3 name prim))]
conflictedEffect (Conflictor FL (PrimWithName name prim) wX wY
_ Set (Contexted (PrimWithName name prim) wY)
_ (forall (p :: * -> * -> *) wX.
Contexted p wX -> Sealed ((:>) (FL p) p wX)
ctxView -> Sealed (FL (PrimWithName name prim) wY wZ
_ :> PrimWithName name prim wZ wX
p))) = [forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Conflicted (forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch PrimWithName name prim wZ wX
p)]
conflictedEffect (Prim PrimWithName name prim wX wY
p) = [forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Okay (forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch PrimWithName name prim wX wY
p)]
instance (Invert prim, Commute prim, Eq2 prim) => Unwind (RepoPatchV3 name prim) where
fullUnwind :: forall wX wY.
RepoPatchV3 name prim wX wY
-> Unwound (PrimOf (RepoPatchV3 name prim)) wX wY
fullUnwind (Prim PrimWithName name prim wX wY
p)
= forall (prim :: * -> * -> *) wA wB wC wD.
(Commute prim, Invert prim, Eq2 prim) =>
FL prim wA wB
-> FL prim wB wC -> FL prim wC wD -> Unwound prim wA wD
mkUnwound forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch PrimWithName name prim wX wY
p forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
fullUnwind
(Conflictor
(forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch -> FL prim wX wY
es)
Set (Contexted (PrimWithName name prim) wY)
_
(forall (p :: * -> * -> *) wX.
Contexted p wX -> Sealed ((:>) (FL p) p wX)
ctxView -> Sealed ((forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch -> FL prim wY wZ
cs) :> (forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch -> prim wZ wX
i)))
) =
forall (prim :: * -> * -> *) wA wB wC wD.
(Commute prim, Invert prim, Eq2 prim) =>
FL prim wA wB
-> FL prim wB wC -> FL prim wC wD -> Unwound prim wA wD
mkUnwound
(FL prim wX wY
es forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wY wZ
cs)
(prim wZ wX
i forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
(forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert prim wZ wX
i forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL prim wY wZ
cs forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
instance PrimPatch prim => Check (RepoPatchV3 name prim)
instance PrimPatch prim => RepairToFL (RepoPatchV3 name prim)
instance (SignedId name, StorableId name, PrimPatch prim)
=> ShowPatch (RepoPatchV3 name prim) where
summary :: forall wX wY. RepoPatchV3 name prim wX wY -> Doc
summary = forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
e wX wY -> Doc
plainSummary
summaryFL :: forall wX wY. FL (RepoPatchV3 name prim) wX wY -> Doc
summaryFL = forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL
thing :: forall wX wY. RepoPatchV3 name prim wX wY -> [Char]
thing RepoPatchV3 name prim wX wY
_ = [Char]
"change"
instance (StorableId name, PrimPatch prim)
=> ShowContextPatch (RepoPatchV3 name prim) where
showContextPatch :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RepoPatchV3 name prim)) m =>
ShowPatchFor -> RepoPatchV3 name prim wX wY -> m Doc
showContextPatch ShowPatchFor
f (Prim PrimWithName name prim wX wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
f PrimWithName name prim wX wY
p
showContextPatch ShowPatchFor
f RepoPatchV3 name prim wX wY
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f RepoPatchV3 name prim wX wY
p
instance (SignedId name, StorableId name, PrimPatch prim)
=> ReadPatch (RepoPatchV3 name prim) where
readPatch' :: forall wX. Parser (Sealed (RepoPatchV3 name prim wX))
readPatch' = do
Parser ()
skipSpace
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ do ByteString -> Parser ()
string ([Char] -> ByteString
BC.pack [Char]
"conflictor")
(Sealed FL (PrimWithName name prim) wX wX
r, Set (Contexted (PrimWithName name prim) Any)
x, Contexted (PrimWithName name prim) Any
p) <- forall {wX} {wX} {wX}.
Parser
ByteString
(Sealed (FL (PrimWithName name prim) wX),
Set (Contexted (PrimWithName name prim) wX),
Contexted (PrimWithName name prim) wX)
readContent
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (forall name (prim :: * -> * -> *) wX wY.
FL (PrimWithName name prim) wX wY
-> Set (Contexted (PrimWithName name prim) wY)
-> Contexted (PrimWithName name prim) wY
-> RepoPatchV3 name prim wX wY
Conflictor FL (PrimWithName name prim) wX wX
r (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall (a :: * -> *) wX wY. a wX -> a wY
unsafeCoerceP1 Set (Contexted (PrimWithName name prim) Any)
x) (forall (a :: * -> *) wX wY. a wX -> a wY
unsafeCoerceP1 Contexted (PrimWithName name prim) Any
p)))
, do forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall name (prim :: * -> * -> *) wX wY.
PrimWithName name prim wX wY -> RepoPatchV3 name prim wX wY
Prim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
]
where
readContent :: Parser
ByteString
(Sealed (FL (PrimWithName name prim) wX),
Set (Contexted (PrimWithName name prim) wX),
Contexted (PrimWithName name prim) wX)
readContent = do
Sealed (FL (PrimWithName name prim) wX)
r <- forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' Char
'[' Char
']'
Set (Contexted (PrimWithName name prim) wX)
x <- forall {wX}.
Parser ByteString (Set (Contexted (PrimWithName name prim) wX))
readCtxSet
Contexted (PrimWithName name prim) wX
p <- forall (p :: * -> * -> *) wX.
(ReadPatch p, PatchListFormat p) =>
Parser (Contexted p wX)
readCtx
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimWithName name prim) wX)
r, Set (Contexted (PrimWithName name prim) wX)
x, Contexted (PrimWithName name prim) wX
p)
readCtxSet :: Parser ByteString (Set (Contexted (PrimWithName name prim) wX))
readCtxSet = (ByteString -> Parser ()
lexString ([Char] -> ByteString
BC.pack [Char]
"{{") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {wX}.
Parser ByteString (Set (Contexted (PrimWithName name prim) wX))
go) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
where
go :: Parser ByteString (Set (Contexted (PrimWithName name prim) wX))
go = (ByteString -> Parser ()
lexString ([Char] -> ByteString
BC.pack [Char]
"}}") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Ord a => a -> Set a -> Set a
S.insert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX.
(ReadPatch p, PatchListFormat p) =>
Parser (Contexted p wX)
readCtx forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Set (Contexted (PrimWithName name prim) wX))
go
instance (StorableId name, PrimPatch prim)
=> ShowPatchBasic (RepoPatchV3 name prim) where
showPatch :: forall wX wY. ShowPatchFor -> RepoPatchV3 name prim wX wY -> Doc
showPatch ShowPatchFor
fmt RepoPatchV3 name prim wX wY
rp =
case RepoPatchV3 name prim wX wY
rp of
Prim PrimWithName name prim wX wY
p -> forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
fmt PrimWithName name prim wX wY
p
Conflictor FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cp -> [Char] -> Doc
blueText [Char]
"conflictor" Doc -> Doc -> Doc
<+> forall {a :: * -> * -> *} {p :: * -> * -> *} {p :: * -> * -> *}
{wX} {wY} {wX} {wX}.
(ShowPatchBasic a, ShowPatchBasic p, ShowPatchBasic p,
PatchListFormat p, PatchListFormat p) =>
FL a wX wY -> Set (Contexted p wX) -> Contexted p wX -> Doc
showContent FL (PrimWithName name prim) wX wY
r Set (Contexted (PrimWithName name prim) wY)
x Contexted (PrimWithName name prim) wY
cp
where
showContent :: FL a wX wY -> Set (Contexted p wX) -> Contexted p wX -> Doc
showContent FL a wX wY
r Set (Contexted p wX)
x Contexted p wX
cp = forall {a :: * -> * -> *} {wX} {wY}.
ShowPatchBasic a =>
FL a wX wY -> Doc
showEffect FL a wX wY
r Doc -> Doc -> Doc
<+> forall {p :: * -> * -> *} {wX}.
(ShowPatchBasic p, PatchListFormat p) =>
Set (Contexted p wX) -> Doc
showCtxSet Set (Contexted p wX)
x Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX.
(ShowPatchBasic p, PatchListFormat p) =>
ShowPatchFor -> Contexted p wX -> Doc
showCtx ShowPatchFor
fmt Contexted p wX
cp
showEffect :: FL a wX wY -> Doc
showEffect FL a wX wY
NilFL = [Char] -> Doc
blueText [Char]
"[]"
showEffect FL a wX wY
ps = [Char] -> Doc
blueText [Char]
"[" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
fmt) FL a wX wY
ps) Doc -> Doc -> Doc
$$ [Char] -> Doc
blueText [Char]
"]"
showCtxSet :: Set (Contexted p wX) -> Doc
showCtxSet Set (Contexted p wX)
xs =
case forall a. Set a -> Maybe (a, Set a)
S.minView Set (Contexted p wX)
xs of
Maybe (Contexted p wX, Set (Contexted p wX))
Nothing -> forall a. Monoid a => a
mempty
Just (Contexted p wX, Set (Contexted p wX))
_ ->
[Char] -> Doc
blueText [Char]
"{{"
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) wX.
(ShowPatchBasic p, PatchListFormat p) =>
ShowPatchFor -> Contexted p wX -> Doc
showCtx ShowPatchFor
fmt) (forall a. Set a -> [a]
S.toAscList Set (Contexted p wX)
xs))
Doc -> Doc -> Doc
$$ [Char] -> Doc
blueText [Char]
"}}"
infixr +|, -|
(+|) :: Ord a => a -> S.Set a -> S.Set a
a
c +| :: forall a. Ord a => a -> Set a -> Set a
+| Set a
cs = forall a. Ord a => a -> Set a -> Set a
S.insert a
c Set a
cs
(-|) :: Ord a => a -> S.Set a -> S.Set a
a
c -| :: forall a. Ord a => a -> Set a -> Set a
-| Set a
cs = forall a. Ord a => a -> Set a -> Set a
S.delete a
c Set a
cs