{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Rebase.Legacy.Item
( RebaseItem(..)
, toRebaseChanges
) where
import Darcs.Prelude
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Named ( Named(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.FromPrim ( PrimPatchBase, PrimOf )
import Darcs.Patch.Rebase.Change ( RebaseChange(..), addNamedToRebase )
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) )
import Darcs.Patch.RepoPatch ( RepoPatch )
import Darcs.Util.Parser ( Parser, lexString )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import qualified Darcs.Util.Diff as D
import Control.Applicative ( (<|>) )
import qualified Data.ByteString as B ( ByteString )
import qualified Data.ByteString.Char8 as BC ( pack )
data RebaseItem p wX wY where
ToEdit :: Named p wX wY -> RebaseItem p wX wY
Fixup :: RebaseFixup (PrimOf p) wX wY -> RebaseItem p wX wY
deriving instance (Show2 p, Show2 (PrimOf p)) => Show (RebaseItem p wX wY)
instance (Show2 p, Show2 (PrimOf p)) => Show1 (RebaseItem p wX)
instance (Show2 p, Show2 (PrimOf p)) => Show2 (RebaseItem p)
toRebaseChanges
:: forall p wX wY
. RepoPatch p
=> FL (RebaseItem p) wX wY
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges FL (RebaseItem p) wX wY
NilFL = forall (a :: * -> *) wY. a wY -> Sealed a
Sealed forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
toRebaseChanges (Fixup RebaseFixup (PrimOf p) wX wY
f :>: FL (RebaseItem p) wY wY
ps) =
case forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges FL (RebaseItem p) wY wY
ps of
Sealed (RC FL (RebaseFixup (PrimOf p)) wY wY
fixups Named (PrimOf p) wY wY
toedit :>: FL (RebaseChange (PrimOf p)) wY wX
rest) -> forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC (RebaseFixup (PrimOf p) wX wY
f forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup (PrimOf p)) wY wY
fixups) Named (PrimOf p) wY wY
toedit forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange (PrimOf p)) wY wX
rest)
Sealed FL (RebaseChange (PrimOf p)) wY wX
NilFL -> forall a. HasCallStack => String -> a
error String
"rebase chain with Fixup at end"
toRebaseChanges (ToEdit Named p wX wY
te :>: FL (RebaseItem p) wY wY
ps) =
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (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 @p DiffAlgorithm
D.MyersDiff Named p wX wY
te) (forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges FL (RebaseItem p) wY wY
ps)
instance (PrimPatchBase p, PatchListFormat p, ReadPatch p) => ReadPatch (RebaseItem p) where
readPatch' :: forall wX. Parser (Sealed (RebaseItem p wX))
readPatch' = forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY.
Named p wX wY -> RebaseItem p wX wY
ToEdit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith (String -> ByteString
BC.pack String
"rebase-toedit") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (forall (p :: * -> * -> *) wX wY.
RebaseFixup (PrimOf p) wX wY -> RebaseItem p wX wY
Fixup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith (String -> ByteString
BC.pack String
"rebase-fixup" ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (forall (p :: * -> * -> *) wX wY.
RebaseFixup (PrimOf p) wX wY -> RebaseItem p wX wY
Fixup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith (String -> ByteString
BC.pack String
"rebase-name" )
where readWith :: forall q wX . ReadPatch q => B.ByteString -> Parser (Sealed (q wX))
readWith :: forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith ByteString
str = do ByteString -> Parser ()
lexString ByteString
str
ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"(")
Sealed (q wX)
res <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
")")
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (q wX)
res