{-# LANGUAGE OverloadedStrings #-}
module Darcs.Repository.Rebase
( withManualRebaseUpdate
, rebaseJob
, startRebaseJob
, maybeDisplaySuspendedStatus
, readTentativeRebase
, writeTentativeRebase
, withTentativeRebase
, createTentativeRebase
, readRebase
, commuteOutOldStyleRebase
, checkOldStyleRebaseStatus
) where
import Darcs.Prelude
import Control.Exception (throwIO )
import Control.Monad ( unless )
import System.Exit ( exitFailure )
import System.IO.Error ( catchIOError, isDoesNotExistError )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Commute ( Commute(..) )
import qualified Darcs.Patch.Named.Wrapped as W
import Darcs.Patch.PatchInfoAnd
( PatchInfoAndG
, hopefully
)
import Darcs.Patch.Read ( readPatch )
import Darcs.Patch.Rebase.Suspended
( Suspended(Items)
, countToEdit
, simplifyPushes
)
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) )
import Darcs.Patch.RepoPatch ( RepoPatch, PrimOf )
import Darcs.Patch.RepoType
( RepoType(..), IsRepoType(..), SRepoType(..)
, RebaseType(..), SRebaseType(..)
)
import Darcs.Patch.Show ( displayPatch, showPatch, ShowPatchFor(ForStorage) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), (:>)(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd )
import Darcs.Repository.Format
( RepoProperty ( RebaseInProgress_2_16, RebaseInProgress )
, formatHas
, addToFormat
, removeFromFormat
, writeRepoFormat
)
import Darcs.Repository.InternalTypes
( Repository
, repoFormat
, withRepoLocation
)
import Darcs.Repository.Paths
( rebasePath
, tentativeRebasePath
, formatPath
)
import Darcs.Util.Diff ( DiffAlgorithm(MyersDiff) )
import Darcs.Util.English ( englishNum, Noun(..) )
import Darcs.Util.Lock ( writeDocBinFile, readBinFile )
import Darcs.Util.Printer ( renderString, text, hsep, vcat, ($$) )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Util.Tree ( Tree )
import Control.Exception ( finally )
withManualRebaseUpdate
:: forall rt p x wR wU wT1 wT2
. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT1
-> (Repository rt p wR wU wT1 -> IO (Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1, x))
-> IO (Repository rt p wR wU wT2, x)
withManualRebaseUpdate :: forall (rt :: RepoType) (p :: * -> * -> *) x wR wU wT1 wT2.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT1
-> (Repository rt p wR wU wT1
-> IO
(Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1,
x))
-> IO (Repository rt p wR wU wT2, x)
withManualRebaseUpdate Repository rt p wR wU wT1
r Repository rt p wR wU wT1
-> IO
(Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1, x)
subFunc
| SRepoType SRebaseType rebaseType
SIsRebase <- forall (rt :: RepoType). IsRepoType rt => SRepoType rt
singletonRepoType :: SRepoType rt = do
Suspended p wT1 wT1
susp <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository rt p wR wU wT1
r
(Repository rt p wR wU wT2
r', FL (RebaseFixup (PrimOf p)) wT2 wT1
fixups, x
x) <- Repository rt p wR wU wT1
-> IO
(Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1, x)
subFunc Repository rt p wR wU wT1
r
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository rt p wR wU wT2
r' (forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY wY
-> Suspended p wX wX
simplifyPushes DiffAlgorithm
MyersDiff FL (RebaseFixup (PrimOf p)) wT2 wT1
fixups Suspended p wT1 wT1
susp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wT2
r', x
x)
| Bool
otherwise = do
(Repository rt p wR wU wT2
r', FL (RebaseFixup (PrimOf p)) wT2 wT1
_, x
x) <- Repository rt p wR wU wT1
-> IO
(Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1, x)
subFunc Repository rt p wR wU wT1
r
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wT2
r', x
x)
catchDoesNotExist :: IO a -> IO a -> IO a
catchDoesNotExist :: forall a. IO a -> IO a -> IO a
catchDoesNotExist IO a
a IO a
b =
IO a
a forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then IO a
b else forall e a. Exception e => e -> IO a
throwIO IOError
e)
checkOldStyleRebaseStatus :: RepoPatch p
=> SRebaseType rebaseType
-> Repository ('RepoType rebaseType) p wR wU wR
-> IO ()
checkOldStyleRebaseStatus :: forall (p :: * -> * -> *) (rebaseType :: RebaseType) wR wU.
RepoPatch p =>
SRebaseType rebaseType
-> Repository ('RepoType rebaseType) p wR wU wR -> IO ()
checkOldStyleRebaseStatus SRebaseType rebaseType
SNoRebase Repository ('RepoType rebaseType) p wR wU wR
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkOldStyleRebaseStatus SRebaseType rebaseType
SIsRebase Repository ('RepoType rebaseType) p wR wU wR
repo = do
Int
count <-
(forall (p :: * -> * -> *) wX wY. Suspended p wX wY -> Int
countToEdit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase Repository ('RepoType rebaseType) p wR wU wR
repo)
forall a. IO a -> IO a -> IO a
`catchDoesNotExist`
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
count forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
Doc -> IO ()
ePutDocLn Doc
upgradeMsg
forall a. IO a
exitFailure
where
upgradeMsg :: Doc
upgradeMsg = [Doc] -> Doc
vcat
[ Doc
"An old-style rebase is in progress in this repository. You can upgrade it"
, Doc
"to the new format using the 'darcs rebase upgrade' command. The repository"
, Doc
"format is unaffected by this, but you won't be able to use a darcs version"
, Doc
"older than 2.16 on this repository until the current rebase is finished."
]
rebaseJob :: (RepoPatch p, ApplyState p ~ Tree)
=> (Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> IO a
rebaseJob :: forall (p :: * -> * -> *) wR wU a.
(RepoPatch p, ApplyState p ~ Tree) =>
(Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
rebaseJob Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
job Repository ('RepoType 'IsRebase) p wR wU wR
repo = do
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
job Repository ('RepoType 'IsRebase) p wR wU wR
repo
forall a b. IO a -> IO b -> IO a
`finally` forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO ()
checkSuspendedStatus Repository ('RepoType 'IsRebase) p wR wU wR
repo
startRebaseJob :: (RepoPatch p, ApplyState p ~ Tree)
=> (Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> IO a
startRebaseJob :: forall (p :: * -> * -> *) wR wU a.
(RepoPatch p, ApplyState p ~ Tree) =>
(Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
startRebaseJob Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
job Repository ('RepoType 'IsRebase) p wR wU wR
repo = do
let rf :: RepoFormat
rf = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository ('RepoType 'IsRebase) p wR wU wR
repo
if RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
rf then
forall (p :: * -> * -> *) (rebaseType :: RebaseType) wR wU.
RepoPatch p =>
SRebaseType rebaseType
-> Repository ('RepoType rebaseType) p wR wU wR -> IO ()
checkOldStyleRebaseStatus SRebaseType 'IsRebase
SIsRebase Repository ('RepoType 'IsRebase) p wR wU wR
repo
else
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress_2_16 RepoFormat
rf) forall a b. (a -> b) -> a -> b
$
RepoFormat -> FilePath -> IO ()
writeRepoFormat (RepoProperty -> RepoFormat -> RepoFormat
addToFormat RepoProperty
RebaseInProgress_2_16 RepoFormat
rf) FilePath
formatPath
forall (p :: * -> * -> *) wR wU a.
(RepoPatch p, ApplyState p ~ Tree) =>
(Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
rebaseJob Repository ('RepoType 'IsRebase) p wR wU wR -> IO a
job Repository ('RepoType 'IsRebase) p wR wU wR
repo
checkSuspendedStatus :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository ('RepoType 'IsRebase) p wR wU wR
-> IO ()
checkSuspendedStatus :: forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO ()
checkSuspendedStatus Repository ('RepoType 'IsRebase) p wR wU wR
_repo = do
Suspended p wR wR
ps <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repo forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repo
case forall (p :: * -> * -> *) wX wY. Suspended p wX wY -> Int
countToEdit Suspended p wR wR
ps of
Int
0 -> do
RepoFormat -> FilePath -> IO ()
writeRepoFormat
(RepoProperty -> RepoFormat -> RepoFormat
removeFromFormat RepoProperty
RebaseInProgress_2_16 forall a b. (a -> b) -> a -> b
$
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository ('RepoType 'IsRebase) p wR wU wR
_repo)
FilePath
formatPath
FilePath -> IO ()
putStrLn FilePath
"Rebase finished!"
Int
n -> Int -> IO ()
displaySuspendedStatus Int
n
displaySuspendedStatus :: Int -> IO ()
displaySuspendedStatus :: Int -> IO ()
displaySuspendedStatus Int
count =
Doc -> IO ()
ePutDocLn forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
[ Doc
"Rebase in progress:"
, FilePath -> Doc
text (forall a. Show a => a -> FilePath
show Int
count)
, Doc
"suspended"
, FilePath -> Doc
text (forall n. Countable n => Int -> n -> ShowS
englishNum Int
count (FilePath -> Noun
Noun FilePath
"patch") FilePath
"")
]
maybeDisplaySuspendedStatus :: RepoPatch p
=> SRebaseType rebaseType
-> Repository ('RepoType rebaseType) p wR wU wR
-> IO ()
maybeDisplaySuspendedStatus :: forall (p :: * -> * -> *) (rebaseType :: RebaseType) wR wU.
RepoPatch p =>
SRebaseType rebaseType
-> Repository ('RepoType rebaseType) p wR wU wR -> IO ()
maybeDisplaySuspendedStatus SRebaseType rebaseType
SIsRebase Repository ('RepoType rebaseType) p wR wU wR
repo = do
Suspended p wR wR
ps <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType rebaseType) p wR wU wR
repo forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase Repository ('RepoType rebaseType) p wR wU wR
repo
Int -> IO ()
displaySuspendedStatus (forall (p :: * -> * -> *) wX wY. Suspended p wX wY -> Int
countToEdit Suspended p wR wR
ps)
maybeDisplaySuspendedStatus SRebaseType rebaseType
SNoRebase Repository ('RepoType rebaseType) p wR wU wR
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
withTentativeRebase
:: RepoPatch p
=> Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT
-> Repository rt p wR wU wY
-> (Suspended p wT wT -> Suspended p wY wY)
-> IO ()
withTentativeRebase Repository rt p wR wU wT
r Repository rt p wR wU wY
r' Suspended p wT wT -> Suspended p wY wY
f =
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository rt p wR wU wT
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository rt p wR wU wY
r' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Suspended p wT wT -> Suspended p wY wY
f
readTentativeRebase :: RepoPatch p
=> Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase = forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> IO (Suspended p wX wX)
readRebaseFile FilePath
tentativeRebasePath
writeTentativeRebase :: RepoPatch p
=> Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase = forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> Suspended p wX wX -> IO ()
writeRebaseFile FilePath
tentativeRebasePath
readRebase :: RepoPatch p => Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase = forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> IO (Suspended p wX wX)
readRebaseFile FilePath
rebasePath
createTentativeRebase :: RepoPatch p => Repository rt p wR wU wR -> IO ()
createTentativeRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO ()
createTentativeRebase Repository rt p wR wU wR
r = forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> Suspended p wX wX -> IO ()
writeRebaseFile FilePath
tentativeRebasePath Repository rt p wR wU wR
r (forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX wX
Items forall (a :: * -> * -> *) wX. FL a wX wX
NilFL :: Suspended p wR wR)
readRebaseFile :: RepoPatch p
=> FilePath -> Repository rt p wR wU wT -> IO (Suspended p wX wX)
readRebaseFile :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> IO (Suspended p wX wX)
readRebaseFile FilePath
path Repository rt p wR wU wT
r =
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r forall a b. (a -> b) -> a -> b
$ do
Either FilePath (Sealed (Suspended p wX))
parsed <- forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either FilePath (Sealed (p wX))
readPatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. FilePathLike p => p -> IO ByteString
readBinFile FilePath
path
case Either FilePath (Sealed (Suspended p wX))
parsed of
Left FilePath
e -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath
"parse error in file " forall a. [a] -> [a] -> [a]
++ FilePath
path, FilePath
e]
Right (Sealed Suspended p wX wX
sp) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd Suspended p wX wX
sp)
writeRebaseFile :: RepoPatch p
=> FilePath -> Repository rt p wR wU wT
-> Suspended p wX wX -> IO ()
writeRebaseFile :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wX.
RepoPatch p =>
FilePath -> Repository rt p wR wU wT -> Suspended p wX wX -> IO ()
writeRebaseFile FilePath
path Repository rt p wR wU wT
r Suspended p wX wX
sp =
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
Repository rt p wR wU wT -> IO a -> IO a
withRepoLocation Repository rt p wR wU wT
r forall a b. (a -> b) -> a -> b
$
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile FilePath
path (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage Suspended p wX wX
sp)
type PiaW rt p = PatchInfoAndG rt (W.WrappedNamed rt p)
commuteOutOldStyleRebase :: RepoPatch p
=> RL (PiaW rt p) wA wB
-> Maybe ((RL (PiaW rt p) :> PiaW rt p) wA wB)
commuteOutOldStyleRebase :: forall (p :: * -> * -> *) (rt :: RepoType) wA wB.
RepoPatch p =>
RL (PiaW rt p) wA wB
-> Maybe ((:>) (RL (PiaW rt p)) (PiaW rt p) wA wB)
commuteOutOldStyleRebase RL (PiaW rt p) wA wB
NilRL = forall a. Maybe a
Nothing
commuteOutOldStyleRebase (RL (PiaW rt p) wA wY
ps :<: PiaW rt p wY wB
p)
| W.RebaseP PatchInfo
_ Suspended p wY wY
_ <- forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PiaW rt p wY wB
p = forall a. a -> Maybe a
Just (RL (PiaW rt p) wA wY
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PiaW rt p wY wB
p)
| Bool
otherwise = do
RL (PiaW rt p) wA wZ
ps' :> PiaW rt p wZ wY
r <- forall (p :: * -> * -> *) (rt :: RepoType) wA wB.
RepoPatch p =>
RL (PiaW rt p) wA wB
-> Maybe ((:>) (RL (PiaW rt p)) (PiaW rt p) wA wB)
commuteOutOldStyleRebase RL (PiaW rt p) wA wY
ps
case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (PiaW rt p wZ wY
r forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PiaW rt p wY wB
p) of
Just (PatchInfoAndG rt (WrappedNamed rt p) wZ wZ
p' :> PatchInfoAndG rt (WrappedNamed rt p) wZ wB
r') -> forall a. a -> Maybe a
Just (RL (PiaW rt p) wA wZ
ps' forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAndG rt (WrappedNamed rt p) wZ wZ
p' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfoAndG rt (WrappedNamed rt p) wZ wB
r')
Maybe ((:>) (PiaW rt p) (PiaW rt p) wZ wB)
Nothing ->
forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ Doc -> FilePath
renderString forall a b. (a -> b) -> a -> b
$ Doc
"internal error: cannot commute rebase patch:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch PiaW rt p wZ wY
r
Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"with normal patch:"
Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch PiaW rt p wY wB
p