module Darcs.Patch.Rebase.Change
( RebaseChange(..)
, toRebaseChanges
, extractRebaseChange
, reifyRebaseChange
, partitionUnconflicted
, rcToPia
, WithDroppedDeps(..)
, WDDNamed
, commuterIdWDD
, simplifyPush, simplifyPushes
, addNamedToRebase
) where
import Darcs.Prelude
import Darcs.Patch.Commute ( commuteFL, commuteRL )
import Darcs.Patch.CommuteFn
( CommuteFn
, MergeFn
, commuterFLId, commuterIdFL
)
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId )
import Darcs.Patch.Info ( PatchInfo, patchinfo, displayPatchInfo )
import Darcs.Patch.Invert ( Invert, invert, invertFL )
import Darcs.Patch.Merge ( selfMerger )
import Darcs.Patch.Named
( Named(..)
, HasDeps(..)
, infopatch
, mergerIdNamed
, patchcontents
, ShowDepsFormat(..)
, showDependencies
)
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, PatchInfoAndG, n2pia )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Show ( ShowPatch(..), displayPatch )
import Darcs.Patch.Summary
( ConflictState(..)
, IsConflictedPrim(..)
, Summary(..)
, plainSummary
, plainSummaryFL
)
import Darcs.Patch.FromPrim ( PrimPatchBase(..), FromPrim(..) )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanFL )
import Darcs.Patch.Prim.Class ( PrimPatch )
import Darcs.Patch.Rebase.Fixup
( RebaseFixup(..)
, commuteFixupNamed, commuteNamedFixup
, flToNamesPrims
, pushFixupFixup
)
import Darcs.Patch.Rebase.Name ( RebaseName(..) )
import Darcs.Patch.Rebase.PushFixup
( PushFixupFn, dropFixups
, pushFixupFLMB_FLFLMB
, pushFixupIdMB_FLFLMB
, pushFixupIdMB_FLIdFLFL
)
import Darcs.Patch.RepoPatch ( RepoPatch )
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(..), ShowContextPatch(..) )
import Darcs.Patch.Unwind ( Unwound(..), fullUnwind )
import Darcs.Patch.Witnesses.Maybe ( Maybe2(..) )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
import Darcs.Util.IsoDate ( getIsoDateTime )
import Darcs.Util.Parser ( lexString )
import Darcs.Util.Printer ( Doc, ($$), ($+$), (<+>), blueText, redText, empty, vcat )
import qualified Data.ByteString.Char8 as BC ( pack )
import Data.List ( (\\) )
import Data.List.Ordered ( nubSort )
import Data.Maybe ( fromMaybe )
data RebaseChange prim wX wY where
RC :: FL (RebaseFixup prim) wX wY -> Named prim wY wZ -> RebaseChange prim wX wZ
instance Show2 prim => Show1 (RebaseChange prim wX)
instance Show2 prim => Show2 (RebaseChange prim)
deriving instance Show2 prim => Show (RebaseChange prim wX wY)
rcToPia :: RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia :: forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toEdit) = forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2 (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia Named prim wY wY
toEdit)
instance PrimPatch prim => PrimPatchBase (RebaseChange prim) where
type PrimOf (RebaseChange prim) = prim
instance PatchDebug prim => PatchDebug (RebaseChange prim)
instance HasDeps (RebaseChange prim) where
getdeps :: forall wX wY. RebaseChange prim wX wY -> [PatchInfo]
getdeps (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named prim wY wY
toedit
type instance PatchId (RebaseChange prim) = PatchInfo
instance Ident (RebaseChange prim) where
ident :: forall wX wY.
RebaseChange prim wX wY -> PatchId (RebaseChange prim)
ident (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident Named prim wY wY
toedit
instance Apply prim => Apply (RebaseChange prim) where
type ApplyState (RebaseChange prim) = ApplyState prim
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
RebaseChange prim wX wY -> m ()
apply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (RebaseFixup prim) wX wY
fixups forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Named prim wY wY
toedit
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
RebaseChange prim wX wY -> m ()
unapply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply Named prim wY wY
toedit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL (RebaseFixup prim) wX wY
fixups
instance Commute prim => Summary (RebaseChange prim) where
conflictedEffect :: forall wX wY.
RebaseChange prim wX wY
-> [IsConflictedPrim (PrimOf (RebaseChange prim))]
conflictedEffect (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) =
case forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup prim) wX wY
fixups of
FL RebaseName wX wZ
_names :> FL prim wZ wY
prims ->
case forall (q :: * -> * -> *) (p :: * -> * -> *) wX wY.
Commute q =>
(forall wA wB. (:>) p q wA wB -> Maybe ((:>) q p wA wB))
-> (:>) p (FL q) wX wY -> (:>) (FL q) (p :> FL q) wX wY
genCommuteWhatWeCanFL (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute) (FL prim wZ wY
prims forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
toedit) of
FL prim wZ wZ
unconflicted :> FL prim wZ wZ
_ :> FL prim wZ wY
conflicted ->
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (prim :: * -> * -> *) wY wY.
ConflictState -> prim wY wY -> IsConflictedPrim prim
IsC ConflictState
Okay) FL prim wZ wZ
unconflicted forall a. [a] -> [a] -> [a]
++ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (prim :: * -> * -> *) wY wY.
ConflictState -> prim wY wY -> IsConflictedPrim prim
IsC ConflictState
Conflicted) FL prim wZ wY
conflicted
instance (ShowPatchBasic prim, Invert prim, PatchListFormat prim)
=> ShowPatchBasic (RebaseChange prim) where
showPatch :: forall wX wY. ShowPatchFor -> RebaseChange prim wX wY -> Doc
showPatch ShowPatchFor
ForStorage (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) =
String -> Doc
blueText String
"rebase-change"
Doc -> Doc -> Doc
<+> String -> Doc
blueText String
"(" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage FL (RebaseFixup prim) wX wY
fixups Doc -> Doc -> Doc
$$ String -> Doc
blueText String
")"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage Named prim wY wY
toedit
showPatch ShowPatchFor
ForDisplay p :: RebaseChange prim wX wY
p@(RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
n [PatchInfo]
_ FL prim wY wY
_)) =
PatchInfo -> Doc
displayPatchInfo PatchInfo
n Doc -> Doc -> Doc
$$ forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent RebaseChange prim wX wY
p
rebaseChangeContent :: (ShowPatchBasic prim, Invert prim)
=> RebaseChange prim wX wY -> Doc
rebaseChangeContent :: forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
contents) =
[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
ForDisplay) (forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
contents)) Doc -> Doc -> Doc
$+$
if forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseFixup prim) wX wY
fixups
then Doc
empty
else String -> Doc
redText String
"conflicts:" Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall {p :: * -> * -> *} {wX} {wY}.
ShowPatchBasic p =>
RebaseFixup p wX wY -> Doc
showFixup (forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL (RebaseFixup prim) wX wY
fixups))
where
showFixup :: RebaseFixup p wX wY -> Doc
showFixup (PrimFixup p wX wY
p) = forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch p wX wY
p
showFixup (NameFixup RebaseName wX wY
n) = forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RebaseName wX wY
n
instance PrimPatch prim => ShowPatch (RebaseChange prim) where
description :: forall wX wY. RebaseChange prim wX wY -> Doc
description (RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
n [PatchInfo]
_ FL prim wY wY
_)) = PatchInfo -> Doc
displayPatchInfo PatchInfo
n
summary :: forall wX wY. RebaseChange prim wX wY -> Doc
summary p :: RebaseChange prim wX wY
p@(RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
_ [PatchInfo]
ds FL prim wY wY
_)) =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds Doc -> Doc -> Doc
$$ forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
e wX wY -> Doc
plainSummary RebaseChange prim wX wY
p
summaryFL :: forall wX wY. FL (RebaseChange prim) wX wY -> Doc
summaryFL FL (RebaseChange prim) wX wY
ps =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary (forall {wX} {wY}. FL (RebaseChange prim) wX wY -> [PatchInfo]
getdepsFL FL (RebaseChange prim) wX wY
ps) Doc -> Doc -> Doc
$$ forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL FL (RebaseChange prim) wX wY
ps
where
getdepsFL :: FL (RebaseChange prim) wX wY -> [PatchInfo]
getdepsFL = forall a. Ord a => [a] -> [a]
nubSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps
content :: forall wX wY. RebaseChange prim wX wY -> Doc
content = forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent
instance (ShowPatchBasic prim, Invert prim, PatchListFormat prim)
=> ShowContextPatch (RebaseChange prim) where
showContextPatch :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
ShowPatchFor -> RebaseChange prim wX wY -> m Doc
showContextPatch ShowPatchFor
f RebaseChange 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 RebaseChange prim wX wY
p
instance (ReadPatch prim, PatchListFormat prim) => ReadPatch (RebaseChange prim) where
readPatch' :: forall wX. Parser (Sealed (RebaseChange prim wX))
readPatch' = do
ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"rebase-change")
ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"(")
Sealed FL (RebaseFixup prim) wX wX
fixups <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
")")
Sealed Named prim wX wX
contents <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wX
fixups Named prim wX wX
contents
toRebaseChanges
:: FL (RebaseChange prim) wX wY
-> FL (PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges :: forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY
-> FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges = 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 (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia
instance Commute prim => Commute (RebaseChange prim) where
commute :: forall wX wY.
(:>) (RebaseChange prim) (RebaseChange prim) wX wY
-> Maybe ((:>) (RebaseChange prim) (RebaseChange prim) wX wY)
commute (RC FL (RebaseFixup prim) wX wY
fixups1 Named prim wY wZ
edit1 :> RC FL (RebaseFixup prim) wZ wY
fixups2 Named prim wY wY
edit2) = do
FL (RebaseFixup prim) wY wZ
fixups2' :> Named prim wZ wY
edit1' <- forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (Named prim) (RebaseFixup prim) wX wY
-> Maybe ((:>) (RebaseFixup prim) (Named prim) wX wY)
commuteNamedFixup (Named prim wY wZ
edit1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
fixups2)
Named prim wZ wZ
edit2' :> Named prim wZ wY
edit1'' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Named prim wZ wY
edit1' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY
edit2)
FL (RebaseFixup prim) wX wZ
fixupsS :> (FL (RebaseFixup prim) wZ wZ
fixups2'' :> Named prim wZ wZ
edit2'') :> FL (RebaseFixup prim) wZ wZ
fixups1' <-
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>)
(FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
(FL (RebaseFixup prim))
((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
wX
wY
pushThrough (FL (RebaseFixup prim) wX wY
fixups1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wY wZ
fixups2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
edit2'))
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC (FL (RebaseFixup prim) wX wZ
fixupsS forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup prim) wZ wZ
fixups2'') Named prim wZ wZ
edit2'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wZ wZ
fixups1' Named prim wZ wY
edit1'')
instance PatchInspect prim => PatchInspect (RebaseChange prim) where
listTouchedFiles :: forall wX wY. RebaseChange prim wX wY -> [AnchoredPath]
listTouchedFiles (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = forall a. Ord a => [a] -> [a]
nubSort (forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (RebaseFixup prim) wX wY
fixup forall a. [a] -> [a] -> [a]
++ forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles Named prim wY wY
toedit)
hunkMatches :: forall wX wY.
(ByteString -> Bool) -> RebaseChange prim wX wY -> Bool
hunkMatches ByteString -> Bool
f (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL (RebaseFixup prim) wX wY
fixup Bool -> Bool -> Bool
|| forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f Named prim wY wY
toedit
partitionUnconflicted
:: Commute prim
=> FL (RebaseChange prim) wX wY
-> (FL (RebaseChange prim) :> RL (RebaseChange prim)) wX wY
partitionUnconflicted :: forall (prim :: * -> * -> *) wX wY.
Commute prim =>
FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
partitionUnconflicted = forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
partitionUnconflictedAcc
:: Commute prim
=> RL (RebaseChange prim) wX wY -> FL (RebaseChange prim) wY wZ
-> (FL (RebaseChange prim) :> RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc :: forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc RL (RebaseChange prim) wX wY
right FL (RebaseChange prim) wY wZ
NilFL = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (RebaseChange prim) wX wY
right
partitionUnconflictedAcc RL (RebaseChange prim) wX wY
right (RebaseChange prim wY wY
p :>: FL (RebaseChange prim) wY wZ
ps) =
case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (RL (RebaseChange prim) wX wY
right forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseChange prim wY wY
p) of
Just (p' :: RebaseChange prim wX wZ
p'@(RC FL (RebaseFixup prim) wX wY
NilFL Named prim wY wZ
_) :> RL (RebaseChange prim) wZ wY
right')
-> case forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc RL (RebaseChange prim) wZ wY
right' FL (RebaseChange prim) wY wZ
ps of
FL (RebaseChange prim) wZ wZ
left' :> RL (RebaseChange prim) wZ wZ
right'' -> (RebaseChange prim wX wZ
p' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wZ wZ
left') forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (RebaseChange prim) wZ wZ
right''
Maybe ((:>) (RebaseChange prim) (RL (RebaseChange prim)) wX wY)
_ -> forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc (RL (RebaseChange prim) wX wY
right forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RebaseChange prim wY wY
p) FL (RebaseChange prim) wY wZ
ps
data WithDroppedDeps p wX wY =
WithDroppedDeps {
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch :: p wX wY,
forall (p :: * -> * -> *) wX wY.
WithDroppedDeps p wX wY -> [PatchInfo]
wddDependedOn :: [PatchInfo]
}
noDroppedDeps :: p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps :: forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps p wX wY
p = forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps p wX wY
p []
instance PrimPatchBase p => PrimPatchBase (WithDroppedDeps p) where
type PrimOf (WithDroppedDeps p) = PrimOf p
instance Effect p => Effect (WithDroppedDeps p) where
effect :: forall wX wY.
WithDroppedDeps p wX wY -> FL (PrimOf (WithDroppedDeps p)) wX wY
effect = forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch
simplifyPush
:: PrimPatch prim
=> D.DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush :: forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush DiffAlgorithm
da RebaseFixup prim wX wY
fixup FL (RebaseChange prim) wY wZ
items = forall (item :: * -> * -> *) (fixup :: * -> * -> *) wX wY.
(:>) item fixup wX wY -> Sealed (item wX)
dropFixups forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(FL (RebaseChange prim))
(FL (RebaseChange prim))
(Maybe2 (RebaseFixup prim))
pushFixupChanges DiffAlgorithm
da (RebaseFixup prim wX wY
fixup forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange prim) wY wZ
items)
simplifyPushes
:: PrimPatch prim
=> D.DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes :: forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
_ FL (RebaseFixup prim) wX wY
NilFL FL (RebaseChange prim) wY wZ
ps = forall (a :: * -> *) wY. a wY -> Sealed a
Sealed FL (RebaseChange prim) wY wZ
ps
simplifyPushes DiffAlgorithm
da (RebaseFixup prim wX wY
f :>: FL (RebaseFixup prim) wY wY
fs) FL (RebaseChange prim) wY wZ
ps = forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush DiffAlgorithm
da RebaseFixup prim wX wY
f) (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da FL (RebaseFixup prim) wY wY
fs FL (RebaseChange prim) wY wZ
ps)
pushFixupChange
:: PrimPatch prim
=> D.DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim) (RebaseChange prim)
(RebaseChange prim) (Maybe2 (RebaseFixup prim))
pushFixupChange :: forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(RebaseChange prim)
(RebaseChange prim)
(Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da (RebaseFixup prim wX wZ
f1 :> RC FL (RebaseFixup prim) wZ wY
fs2 Named prim wY wY
e)
= case forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item (FL item) (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupFLMB_FLFLMB (forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(RebaseFixup prim)
(FL (RebaseFixup prim))
(Maybe2 (RebaseFixup prim))
pushFixupFixup DiffAlgorithm
da) (RebaseFixup prim wX wZ
f1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
fs2) of
FL (RebaseFixup prim) wX wZ
fs2' :> Maybe2 (RebaseFixup prim) wZ wY
Nothing2 -> forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wZ
fs2' Named prim wY wY
e forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
FL (RebaseFixup prim) wX wZ
fs2' :> Just2 RebaseFixup prim wZ wY
f1' ->
case forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (RebaseFixup prim) (Named prim) wX wY
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wX wY)
commuteFixupNamed (RebaseFixup prim wZ wY
f1' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY
e) of
Maybe ((:>) (Named prim) (RebaseFixup prim) wZ wY)
Nothing -> forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC (FL (RebaseFixup prim) wX wZ
fs2' forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ RebaseFixup prim wZ wY
f1' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) Named prim wY wY
e forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
Just (Named prim wZ wZ
e' :> RebaseFixup prim wZ wY
f1'') -> forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wZ
fs2' Named prim wZ wZ
e' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY. p wX wY -> Maybe2 p wX wY
Just2 RebaseFixup prim wZ wY
f1''
pushFixupChanges
:: PrimPatch prim
=> D.DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim) (FL (RebaseChange prim))
(FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim))
pushFixupChanges :: forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(FL (RebaseChange prim))
(FL (RebaseChange prim))
(Maybe2 (RebaseFixup prim))
pushFixupChanges DiffAlgorithm
da = forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupIdMB_FLFLMB (forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(RebaseChange prim)
(RebaseChange prim)
(Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da)
pushFixupsChange
:: PrimPatch prim
=> D.DiffAlgorithm
-> PushFixupFn
(FL (RebaseFixup prim)) (RebaseChange prim)
(RebaseChange prim) (FL (RebaseFixup prim))
pushFixupsChange :: forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(FL (RebaseFixup prim))
(RebaseChange prim)
(RebaseChange prim)
(FL (RebaseFixup prim))
pushFixupsChange DiffAlgorithm
da = forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn (FL fixup) item item (FL fixup)
pushFixupIdMB_FLIdFLFL (forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(RebaseFixup prim)
(RebaseChange prim)
(RebaseChange prim)
(Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da)
pushThrough
:: Commute prim
=> (FL (RebaseFixup prim) :> (FL (RebaseFixup prim) :> Named prim)) wX wY
-> (FL (RebaseFixup prim) :> (FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim)) wX wY
pushThrough :: forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>)
(FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
(FL (RebaseFixup prim))
((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
wX
wY
pushThrough (FL (RebaseFixup prim) wX wZ
NilFL :> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
pushThrough ((RebaseFixup prim wX wY
p :>: FL (RebaseFixup prim) wY wZ
ps) :> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) =
case forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>)
(FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
(FL (RebaseFixup prim))
((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
wX
wY
pushThrough (FL (RebaseFixup prim) wY wZ
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) of
FL (RebaseFixup prim) wY wZ
psS :> v' :: (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
v'@(FL (RebaseFixup prim) wZ wZ
qs:>Named prim wZ wZ
te) :> FL (RebaseFixup prim) wZ wY
ps' ->
forall a. a -> Maybe a -> a
fromMaybe ((RebaseFixup prim wX wY
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wY wZ
psS) forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
v' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
ps') forall a b. (a -> b) -> a -> b
$ do
FL (RebaseFixup prim) wX wZ
psS' :> RebaseFixup prim wZ wZ
p' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wX wY
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wY wZ
psS)
FL (RebaseFixup prim) wZ wZ
qs' :> RebaseFixup prim wZ wZ
p'' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wZ wZ
p' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wZ
qs)
Named prim wZ wZ
te' :> RebaseFixup prim wZ wZ
p''' <- forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (RebaseFixup prim) (Named prim) wX wY
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wX wY)
commuteFixupNamed (RebaseFixup prim wZ wZ
p'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseFixup prim) wX wZ
psS' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wZ wZ
qs' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te') forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (RebaseFixup prim wZ wZ
p''' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wZ wY
ps'))
type WDDNamed p = WithDroppedDeps (Named p)
mergerIdWDD :: MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD MergeFn p1 p2
merger (p1 wZ wX
p1 :\/: WithDroppedDeps p2 wZ wY
p2 [PatchInfo]
deps) =
case MergeFn p1 p2
merger (p1 wZ wX
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: p2 wZ wY
p2) of
p2 wX wZ
p2' :/\: p1 wY wZ
p1' -> forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps p2 wX wZ
p2' [PatchInfo]
deps forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: p1 wY wZ
p1'
commuterIdWDD :: CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD :: forall (p :: * -> * -> *) (q :: * -> * -> *).
CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD CommuteFn p q
commuter (p wX wZ
p :> WithDroppedDeps q wZ wY
q [PatchInfo]
deps)
= do
q wX wZ
q' :> p wZ wY
p' <- CommuteFn p q
commuter (p wX wZ
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> q wZ wY
q)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps q wX wZ
q' [PatchInfo]
deps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p')
forceCommuteName :: (RebaseName :> WDDNamed p) wX wY -> (WDDNamed p :> RebaseName) wX wY
forceCommuteName :: forall (p :: * -> * -> *) wX wY.
(:>) RebaseName (WDDNamed p) wX wY
-> (:>) (WDDNamed p) RebaseName wX wY
forceCommuteName (AddName PatchInfo
an :> WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
body) [PatchInfo]
ddeps)
| PatchInfo
an forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
| Bool
otherwise =
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps
(forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn ([PatchInfo]
deps forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo
an]) (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body))
(if PatchInfo
an forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps then PatchInfo
an forall a. a -> [a] -> [a]
: [PatchInfo]
ddeps else [PatchInfo]
ddeps)
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
an
forceCommuteName (DelName PatchInfo
dn :> p :: WDDNamed p wZ wY
p@(WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
_body) [PatchInfo]
_ddeps))
| PatchInfo
dn forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
| PatchInfo
dn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. HasCallStack => String -> a
error String
"impossible case"
| Bool
otherwise = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP WDDNamed p wZ wY
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
dn
forceCommuteName (Rename PatchInfo
old PatchInfo
new :> WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
body) [PatchInfo]
ddeps)
| PatchInfo
old forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
| PatchInfo
new forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
| PatchInfo
old forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. HasCallStack => String -> a
error String
"impossible case"
| Bool
otherwise =
let newdeps :: [PatchInfo]
newdeps = forall a b. (a -> b) -> [a] -> [b]
map (\PatchInfo
dep -> if PatchInfo
new forall a. Eq a => a -> a -> Bool
== PatchInfo
dep then PatchInfo
old else PatchInfo
dep) [PatchInfo]
deps
in forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn [PatchInfo]
newdeps (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body)) [PatchInfo]
ddeps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new
forceCommutePrim :: RepoPatch p
=> (PrimOf p :> WDDNamed p) wX wY
-> (WDDNamed p :> FL (PrimOf p)) wX wY
forceCommutePrim :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (PrimOf p) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (PrimOf p)) wX wY
forceCommutePrim (PrimOf p wX wZ
p :> WDDNamed p wZ wY
wq) =
let rp :: p wX wZ
rp = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim PrimOf p wX wZ
p
irp :: p wZ wX
irp = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimOf p wX wZ
p)
in case forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed forall (p :: * -> * -> *). Merge p => MergeFn p p
selfMerger) (p wZ wX
irp forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: WDDNamed p wZ wY
wq) of
WithDroppedDeps (Named p) wX wZ
wq' :/\: p wY wZ
irp' -> forall {p :: * -> * -> *} {wX} {wY} {wY}.
FL p wX wY
-> WithDroppedDeps (Named p) wY wY
-> WithDroppedDeps (Named p) wX wY
prefixWith (p wX wZ
rp forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wZ wX
irp forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) WithDroppedDeps (Named p) wX wZ
wq' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect p wY wZ
irp')
where
prefixWith :: FL p wX wY
-> WithDroppedDeps (Named p) wY wY
-> WithDroppedDeps (Named p) wX wY
prefixWith FL p wX wY
xs (WithDroppedDeps (NamedP PatchInfo
i [PatchInfo]
ds FL p wY wY
ps) [PatchInfo]
dds) =
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
ds (FL p wX wY
xs forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL p wY wY
ps)) [PatchInfo]
dds
forceCommutes :: RepoPatch p
=> (FL (RebaseFixup (PrimOf p)) :> WDDNamed p) wX wY
-> (WDDNamed p :> FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wX wZ
NilFL :> WDDNamed p wZ wY
q) = WDDNamed p wZ wY
q forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
forceCommutes ((NameFixup RebaseName wX wY
n :>: FL (RebaseFixup (PrimOf p)) wY wZ
ps) :> WDDNamed p wZ wY
q) =
case forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wY wZ
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wZ wY
q) of
WDDNamed p wY wZ
q' :> FL (RebaseFixup (PrimOf p)) wZ wY
ps' ->
case forall (p :: * -> * -> *) wX wY.
(:>) RebaseName (WDDNamed p) wX wY
-> (:>) (WDDNamed p) RebaseName wX wY
forceCommuteName (RebaseName wX wY
n forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wY wZ
q') of
WDDNamed p wX wZ
q'' :> RebaseName wZ wZ
n' -> WDDNamed p wX wZ
q'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup RebaseName wZ wZ
n' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup (PrimOf p)) wZ wY
ps')
forceCommutes ((PrimFixup PrimOf p wX wY
p :>: FL (RebaseFixup (PrimOf p)) wY wZ
ps) :> WDDNamed p wZ wY
q) =
case forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wY wZ
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wZ wY
q) of
WDDNamed p wY wZ
q' :> FL (RebaseFixup (PrimOf p)) wZ wY
ps' ->
case forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (PrimOf p) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (PrimOf p)) wX wY
forceCommutePrim (PrimOf p wX wY
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wY wZ
q') of
WDDNamed p wX wZ
qs'' :> FL (PrimOf p) wZ wZ
p' -> WDDNamed p wX wZ
qs'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf p) wZ wZ
p' forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup (PrimOf p)) wZ wY
ps')
fromPrimNamed :: FromPrim p => Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed (NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf p) wX wY
ps) = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY
fromPrims PatchInfo
n FL (PrimOf p) wX wY
ps)
extractRebaseChange
:: forall p wX wY
. RepoPatch p
=> D.DiffAlgorithm
-> FL (RebaseChange (PrimOf p)) wX wY
-> (FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wX wY
DiffAlgorithm
da FL (RebaseChange (PrimOf p)) wX wY
rcs = forall wA wB.
(:>)
(FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wX wY
rcs)
where
go
:: forall wA wB
. (FL (RebaseFixup (PrimOf p)) :> FL (RebaseChange (PrimOf p))) wA wB
-> (FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wA wB
go :: forall wA wB.
(:>)
(FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn :> FL (RebaseChange (PrimOf p)) wZ wB
NilFL) = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn
go (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn :> RebaseChange (PrimOf p) wZ wY
rc :>: FL (RebaseChange (PrimOf p)) wY wB
rest) =
case forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
(FL (RebaseFixup prim))
(RebaseChange prim)
(RebaseChange prim)
(FL (RebaseFixup prim))
pushFixupsChange DiffAlgorithm
da (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseChange (PrimOf p) wZ wY
rc) of
RC FL (RebaseFixup (PrimOf p)) wA wY
fixups Named (PrimOf p) wY wZ
toedit :> FL (RebaseFixup (PrimOf p)) wZ wY
fixupsOut2 ->
case forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wA wY
fixups forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wZ
toedit) []) of
WDDNamed p wA wZ
toedit' :> FL (RebaseFixup (PrimOf p)) wZ wZ
fixupsOut1 ->
case forall wA wB.
(:>)
(FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (FL (RebaseFixup (PrimOf p)) wZ wZ
fixupsOut1 forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup (PrimOf p)) wZ wY
fixupsOut2 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wY wB
rest) of
FL (WDDNamed p) wZ wZ
toedits' :> FL (RebaseFixup (PrimOf p)) wZ wB
fixupsOut -> WDDNamed p wA wZ
toedit' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WDDNamed p) wZ wZ
toedits' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wZ wB
fixupsOut
reifyRebaseChange
:: FromPrim p
=> String
-> FL (RebaseChange (PrimOf p)) wX wY
-> IO ((FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wX wY)
reifyRebaseChange :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
String
-> FL (RebaseChange (PrimOf p)) wX wY
-> IO ((:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY)
reifyRebaseChange String
author FL (RebaseChange (PrimOf p)) wX wY
rs = do
FL (WDDNamed p) wX wY
res <- forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
Monad m =>
(forall wW wY. a wW wY -> m (b wW wY))
-> FL a wX wZ -> m (FL b wX wZ)
mapFL_FL_M forall (p :: * -> * -> *) wA wB.
FromPrim p =>
RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne FL (RebaseChange (PrimOf p)) wX wY
rs
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (WDDNamed p) wX wY
res forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
where
reifyOne :: FromPrim p => RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne :: forall (p :: * -> * -> *) wA wB.
FromPrim p =>
RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne (RC FL (RebaseFixup (PrimOf p)) wA wY
fixups Named (PrimOf p) wY wB
toedit) =
case forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup (PrimOf p)) wA wY
fixups of
FL RebaseName wA wZ
names :> FL (PrimOf p) wZ wY
NilFL ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
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 (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
FL RebaseName wA wZ
names :> FL (PrimOf p) wZ wY
prims -> do
Named p wZ wY
n <- forall (p :: * -> * -> *) wX wY.
FromPrim p =>
String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified String
author FL (PrimOf p) wZ wY
prims
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
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 (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps Named p wZ wY
n forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
mkReified :: FromPrim p => String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified String
author FL (PrimOf p) wX wY
ps = do
let name :: String
name = String
"Reified fixup patch"
let desc :: [a]
desc = []
String
date <- IO String
getIsoDateTime
PatchInfo
info <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
author forall a. [a]
desc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
info FL (PrimOf p) wX wY
ps
mkDummy :: FromPrim p => RebaseName wX wY -> Named p wX wY
mkDummy :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy (AddName PatchInfo
pi) = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
pi (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
mkDummy (DelName PatchInfo
_) = forall a. HasCallStack => String -> a
error String
"internal error: can't make a dummy patch from a delete"
mkDummy (Rename PatchInfo
_ PatchInfo
_) = forall a. HasCallStack => String -> a
error String
"internal error: can't make a dummy patch from a rename"
instance IsHunk (RebaseChange prim) where
isHunk :: forall wX wY. RebaseChange prim wX wY -> Maybe (FileHunk wX wY)
isHunk RebaseChange prim wX wY
_ = forall a. Maybe a
Nothing
instance PatchListFormat (RebaseChange prim)
addNamedToRebase
:: RepoPatch p
=> D.DiffAlgorithm
-> Named p wX wY
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
addNamedToRebase :: forall (p :: * -> * -> *) wX wY wZ.
RepoPatch p =>
DiffAlgorithm
-> Named p wX wY
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
addNamedToRebase DiffAlgorithm
da named :: Named p wX wY
named@(NamedP PatchInfo
n [PatchInfo]
deps FL p wX wY
_) =
case forall (p :: * -> * -> *) wX wY.
Unwind p =>
p wX wY -> Unwound (PrimOf p) wX wY
fullUnwind Named p wX wY
named of
Unwound FL (PrimOf (Named p)) wX wB
before FL (PrimOf (Named p)) wB wC
underlying RL (PrimOf (Named p)) wC wY
after ->
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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 (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf (Named p)) wX wB
before)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal ((forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf (Named p)) wB wC
underlying) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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 (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimOf (Named p)) wC wY
after))