{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Rebase.Suspended
( Suspended(..)
, countToEdit, simplifyPush, simplifyPushes
, addFixupsToSuspended, removeFixupsFromSuspended
, addToEditsToSuspended
, readSuspended
, showSuspended
) where
import Darcs.Prelude
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.Invert ( invert )
import Darcs.Patch.Named ( Named(..) )
import Darcs.Patch.Info ( replaceJunk )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
import Darcs.Patch.Read ( bracketedFL )
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..), namedToFixups )
import Darcs.Patch.Rebase.Name ( RebaseName(..) )
import Darcs.Patch.RepoPatch ( RepoPatch )
import qualified Darcs.Patch.Rebase.Change as Change ( simplifyPush, simplifyPushes )
import Darcs.Patch.Rebase.Change ( RebaseChange(..), addNamedToRebase )
import Darcs.Patch.Rebase.Legacy.Item as Item ( toRebaseChanges )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor )
import Darcs.Util.Parser ( Parser, lexString, lexWord )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.Witnesses.Show ( Show2 )
import Darcs.Util.Printer ( Doc, vcat, text, blueText, ($$), (<+>) )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm(MyersDiff) )
import Control.Applicative ( (<|>) )
import qualified Data.ByteString.Char8 as BC ( pack )
data Suspended p wX where
Items :: FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
deriving instance (Show2 p, Show2 (PrimOf p)) => Show (Suspended p wX)
showSuspended :: PrimPatchBase p
=> ShowPatchFor -> Suspended p wX -> Doc
showSuspended :: forall (p :: * -> * -> *) wX.
PrimPatchBase p =>
ShowPatchFor -> Suspended p wX -> Doc
showSuspended ShowPatchFor
f (Items FL (RebaseChange (PrimOf p)) wX wY
ps)
= String -> Doc
blueText String
"rebase" Doc -> Doc -> Doc
<+> String -> Doc
text String
"0.2" Doc -> Doc -> Doc
<+> String -> Doc
blueText String
"{"
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. RebaseChange (PrimOf p) wW wZ -> Doc)
-> FL (RebaseChange (PrimOf p)) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> RebaseChange (PrimOf p) wW wZ -> Doc
forall wX wY. ShowPatchFor -> RebaseChange (PrimOf p) wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f) FL (RebaseChange (PrimOf p)) wX wY
ps)
Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"}"
readSuspended :: forall p wX. RepoPatch p => Parser (Suspended p wX)
readSuspended :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Suspended p wX)
readSuspended =
do ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"rebase")
ByteString
version <- Parser ByteString
lexWord
case () of
()
_ | ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"0.2" ->
(ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"{}") Parser () -> Parser (Suspended p wX) -> Parser (Suspended p wX)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Suspended p wX -> Parser (Suspended p wX)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items FL (RebaseChange (PrimOf p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL))
Parser (Suspended p wX)
-> Parser (Suspended p wX) -> Parser (Suspended p wX)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items (Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX)
-> Parser ByteString (Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Parser (Suspended p wX)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wY. Parser (Sealed (RebaseChange (PrimOf p) wY)))
-> Char
-> Char
-> Parser ByteString (Sealed (FL (RebaseChange (PrimOf p)) wX))
forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL Parser (Sealed (RebaseChange (PrimOf p) wY))
forall wY. Parser (Sealed (RebaseChange (PrimOf p) wY))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' Char
'{' Char
'}')
| ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"0.0" ->
(ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"{}") Parser () -> Parser (Suspended p wX) -> Parser (Suspended p wX)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Suspended p wX -> Parser (Suspended p wX)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items FL (RebaseChange (PrimOf p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL))
Parser (Suspended p wX)
-> Parser (Suspended p wX) -> Parser (Suspended p wX)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items (Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX)
-> (Sealed (FL (RebaseItem p) wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Sealed (FL (RebaseItem p) wX)
-> Suspended p wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX.
FL (RebaseItem p) wX wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Sealed (FL (RebaseItem p) wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
Item.toRebaseChanges @p) (Sealed (FL (RebaseItem p) wX) -> Suspended p wX)
-> Parser ByteString (Sealed (FL (RebaseItem p) wX))
-> Parser (Suspended p wX)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall wY. Parser (Sealed (RebaseItem p wY)))
-> Char
-> Char
-> Parser ByteString (Sealed (FL (RebaseItem p) wX))
forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL Parser (Sealed (RebaseItem p wY))
forall wY. Parser (Sealed (RebaseItem p wY))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' Char
'{' Char
'}')
| Bool
otherwise -> String -> Parser (Suspended p wX)
forall a. HasCallStack => String -> a
error (String -> Parser (Suspended p wX))
-> String -> Parser (Suspended p wX)
forall a b. (a -> b) -> a -> b
$ String
"can't handle rebase version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
version
countToEdit :: Suspended p wX -> Int
countToEdit :: forall (p :: * -> * -> *) wX. Suspended p wX -> Int
countToEdit (Items FL (RebaseChange (PrimOf p)) wX wY
ps) = FL (RebaseChange (PrimOf p)) wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (RebaseChange (PrimOf p)) wX wY
ps
addFixupsToSuspended
:: (PrimPatchBase p, Effect p)
=> Named p wX wY
-> Suspended p wY
-> Suspended p wX
addFixupsToSuspended :: forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Effect p) =>
Named p wX wY -> Suspended p wY -> Suspended p wX
addFixupsToSuspended Named p wX wY
p = DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY
-> Suspended p wX
forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY
-> Suspended p wX
simplifyPushes DiffAlgorithm
D.MyersDiff (Named p wX wY -> FL (RebaseFixup (PrimOf p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
Named p wX wY -> FL (RebaseFixup (PrimOf p)) wX wY
namedToFixups Named p wX wY
p)
removeFixupsFromSuspended
:: (PrimPatchBase p, Effect p)
=> Named p wX wY
-> Suspended p wX
-> Suspended p wY
removeFixupsFromSuspended :: forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Effect p) =>
Named p wX wY -> Suspended p wX -> Suspended p wY
removeFixupsFromSuspended Named p wX wY
p =
DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wY wX
-> Suspended p wX
-> Suspended p wY
forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY
-> Suspended p wX
simplifyPushes DiffAlgorithm
D.MyersDiff (FL (RebaseFixup (PrimOf p)) wX wY
-> FL (RebaseFixup (PrimOf p)) wY wX
forall wX wY.
FL (RebaseFixup (PrimOf p)) wX wY
-> FL (RebaseFixup (PrimOf p)) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (Named p wX wY -> FL (RebaseFixup (PrimOf p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
Named p wX wY -> FL (RebaseFixup (PrimOf p)) wX wY
namedToFixups Named p wX wY
p))
addToEditsToSuspended
:: RepoPatch p
=> D.DiffAlgorithm
-> FL (Named p) wX wY
-> Suspended p wY
-> IO (Suspended p wX)
addToEditsToSuspended :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (Named p) wX wY -> Suspended p wY -> IO (Suspended p wX)
addToEditsToSuspended DiffAlgorithm
_ FL (Named p) wX wY
NilFL Suspended p wY
items = Suspended p wX -> IO (Suspended p wX)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Suspended p wX
Suspended p wY
items
addToEditsToSuspended DiffAlgorithm
da (NamedP PatchInfo
old [PatchInfo]
ds FL p wX wY
ps :>: FL (Named p) wY wY
qs) Suspended p wY
items = do
Items FL (RebaseChange (PrimOf p)) wY wY
items' <- DiffAlgorithm
-> FL (Named p) wY wY -> Suspended p wY -> IO (Suspended p wY)
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (Named p) wX wY -> Suspended p wY -> IO (Suspended p wX)
addToEditsToSuspended DiffAlgorithm
da FL (Named p) wY wY
qs Suspended p wY
items
PatchInfo
new <- PatchInfo -> IO PatchInfo
replaceJunk PatchInfo
old
Suspended p wX -> IO (Suspended p wX)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Suspended p wX -> IO (Suspended p wX))
-> Suspended p wX -> IO (Suspended p wX)
forall a b. (a -> b) -> a -> b
$
(forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items (Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall a b. (a -> b) -> a -> b
$
(forall wX.
FL (RebaseChange (PrimOf p)) wY wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Sealed (FL (RebaseChange (PrimOf p)) wY)
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> Named p wX wY
-> FL (RebaseChange (PrimOf p)) wY wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
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 (PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
new [PatchInfo]
ds FL p wX wY
ps)) (Sealed (FL (RebaseChange (PrimOf p)) wY)
-> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Sealed (FL (RebaseChange (PrimOf p)) wY)
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall a b. (a -> b) -> a -> b
$
DiffAlgorithm
-> RebaseFixup (PrimOf p) wY wY
-> FL (RebaseChange (PrimOf p)) wY wY
-> Sealed (FL (RebaseChange (PrimOf p)) wY)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
Change.simplifyPush DiffAlgorithm
da (RebaseName wY wY -> RebaseFixup (PrimOf p) wY wY
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (PatchInfo -> PatchInfo -> RebaseName wY wY
forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
new PatchInfo
old)) FL (RebaseChange (PrimOf p)) wY wY
items'
simplifyPush
:: PrimPatchBase p
=> D.DiffAlgorithm
-> RebaseFixup (PrimOf p) wX wY
-> Suspended p wY
-> Suspended p wX
simplifyPush :: forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
DiffAlgorithm
-> RebaseFixup (PrimOf p) wX wY -> Suspended p wY -> Suspended p wX
simplifyPush DiffAlgorithm
da RebaseFixup (PrimOf p) wX wY
fixups (Items FL (RebaseChange (PrimOf p)) wY wY
ps) =
(forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items (DiffAlgorithm
-> RebaseFixup (PrimOf p) wX wY
-> FL (RebaseChange (PrimOf p)) wY wY
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
Change.simplifyPush DiffAlgorithm
da RebaseFixup (PrimOf p) wX wY
fixups FL (RebaseChange (PrimOf p)) wY wY
ps)
simplifyPushes
:: PrimPatchBase p
=> D.DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY
-> Suspended p wX
simplifyPushes :: forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> Suspended p wY
-> Suspended p wX
simplifyPushes DiffAlgorithm
da FL (RebaseFixup (PrimOf p)) wX wY
fixups (Items FL (RebaseChange (PrimOf p)) wY wY
ps) =
(forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wX) -> Suspended p wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall wX. FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items (DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wY
-> FL (RebaseChange (PrimOf p)) wY wY
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
Change.simplifyPushes DiffAlgorithm
da FL (RebaseFixup (PrimOf p)) wX wY
fixups FL (RebaseChange (PrimOf p)) wY wY
ps)