--  Copyright (C) 2009-2012 Ganesh Sittampalam
--
--  BSD3
{-# LANGUAGE OverloadedStrings #-}
module Darcs.Repository.Rebase
    ( withManualRebaseUpdate
    , rebaseJob
    , startRebaseJob
    , maybeDisplaySuspendedStatus
    -- create/read/write rebase patch
    , 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
      -- HACK overwrite the changes that were made by subFunc
      -- which may and indeed does call add/remove patch
      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
    -- if the format says we have a rebase in progress,
    -- but initially we have zero new-style suspended patches
    -- this means an old-style rebase is in progress
    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."
      ]

-- | got a rebase operation to run where it is required that a rebase is
-- already in progress
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
      -- The use of finally here is because various things in job
      -- might cause an "expected" early exit leaving us needing
      -- to remove the rebase-in-progress state (e.g. when suspending,
      -- conflicts with recorded, user didn't specify any patches).
      --
      -- The better fix would be to standardise expected early exits
      -- e.g. using a layer on top of IO or a common Exception type
      -- and then just catch those.
      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

-- | Got a rebase operation to run where we may need to initialise the
-- rebase state first. Make sure you have taken the lock before calling this.
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
"")
    ]

-- | Generic status display for non-rebase commands.
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)

-- unsafe witnesses, not exported
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)

-- unsafe witnesses, not exported
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