{-# 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 )

-- |A single item in the rebase state consists of either
-- a patch that is being edited, or a fixup that adjusts
-- the context so that a subsequent patch that is being edited
-- \"makes sense\".
--
-- @ToEdit@ holds a patch that is being edited. The name ('PatchInfo') of
-- the patch will typically be the name the patch had before
-- it was added to the rebase state; if it is moved back
-- into the repository it must be given a fresh name to account
-- for the fact that it will not necessarily have the same
-- dependencies or content as the original patch. This is typically
-- done by changing the @Ignore-This@ junk.
--
-- @Fixup@ adjusts the context so that a subsequent @ToEdit@ patch
-- is correct. Where possible, @Fixup@ changes are commuted
-- as far as possible into the rebase state, so any remaining
-- ones will typically cause a conflict when the @ToEdit@ patch
-- is moved back into the repository.
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 :: FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges FL (RebaseItem p) wX wY
NilFL = FL (RebaseChange (PrimOf p)) wX wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (RebaseChange (PrimOf p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
toRebaseChanges (Fixup RebaseFixup (PrimOf p) wX wY
f :>: FL (RebaseItem p) wY wY
ps) =
    case FL (RebaseItem p) wY wY -> Sealed (FL (RebaseChange (PrimOf p)) wY)
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) -> FL (RebaseChange (PrimOf p)) wX wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (RebaseFixup (PrimOf p)) wX wY
-> Named (PrimOf p) wY wY -> RebaseChange (PrimOf p) wX wY
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 RebaseFixup (PrimOf p) wX wY
-> FL (RebaseFixup (PrimOf p)) wY wY
-> FL (RebaseFixup (PrimOf p)) wX wY
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 RebaseChange (PrimOf p) wX wY
-> FL (RebaseChange (PrimOf p)) wY wX
-> FL (RebaseChange (PrimOf p)) wX wX
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 -> String -> Sealed (FL (RebaseChange (PrimOf p)) wX)
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 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 @p DiffAlgorithm
D.MyersDiff Named p wX wY
te) (FL (RebaseItem p) wY wY -> Sealed (FL (RebaseChange (PrimOf p)) wY)
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (RebaseItem p) wX wY -> Sealed (FL (RebaseChange (PrimOf p)) wX)
toRebaseChanges FL (RebaseItem p) wY wY
ps)

-- This Read instance partly duplicates the instances for RebaseFixup,
-- but are left this way given this code is now here only for backwards compatibility of the on-disk
-- format and we might want to make future changes to RebaseFixup.
instance (PrimPatchBase p, PatchListFormat p, ReadPatch p) => ReadPatch (RebaseItem p) where
   readPatch' :: Parser (Sealed (RebaseItem p wX))
readPatch' = (forall wX. Named p wX wX -> RebaseItem p wX wX)
-> Sealed (Named p wX) -> Sealed (RebaseItem p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. Named p wX wX -> RebaseItem p wX wX
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> RebaseItem p wX wY
ToEdit              (Sealed (Named p wX) -> Sealed (RebaseItem p wX))
-> Parser ByteString (Sealed (Named p wX))
-> Parser (Sealed (RebaseItem p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser ByteString (Sealed (Named p wX))
forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith (String -> ByteString
BC.pack String
"rebase-toedit") Parser (Sealed (RebaseItem p wX))
-> Parser (Sealed (RebaseItem p wX))
-> Parser (Sealed (RebaseItem p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                (forall wX. PrimOf p wX wX -> RebaseItem p wX wX)
-> Sealed (PrimOf p wX) -> Sealed (RebaseItem p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (RebaseFixup (PrimOf p) wX wX -> RebaseItem p wX wX
forall (p :: * -> * -> *) wX wY.
RebaseFixup (PrimOf p) wX wY -> RebaseItem p wX wY
Fixup (RebaseFixup (PrimOf p) wX wX -> RebaseItem p wX wX)
-> (PrimOf p wX wX -> RebaseFixup (PrimOf p) wX wX)
-> PrimOf p wX wX
-> RebaseItem p wX wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOf p wX wX -> RebaseFixup (PrimOf p) wX wX
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup) (Sealed (PrimOf p wX) -> Sealed (RebaseItem p wX))
-> Parser ByteString (Sealed (PrimOf p wX))
-> Parser (Sealed (RebaseItem p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser ByteString (Sealed (PrimOf p wX))
forall (q :: * -> * -> *) wX.
ReadPatch q =>
ByteString -> Parser (Sealed (q wX))
readWith (String -> ByteString
BC.pack String
"rebase-fixup" ) Parser (Sealed (RebaseItem p wX))
-> Parser (Sealed (RebaseItem p wX))
-> Parser (Sealed (RebaseItem p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                (forall wX. RebaseName wX wX -> RebaseItem p wX wX)
-> Sealed (RebaseName wX) -> Sealed (RebaseItem p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (RebaseFixup (PrimOf p) wX wX -> RebaseItem p wX wX
forall (p :: * -> * -> *) wX wY.
RebaseFixup (PrimOf p) wX wY -> RebaseItem p wX wY
Fixup (RebaseFixup (PrimOf p) wX wX -> RebaseItem p wX wX)
-> (RebaseName wX wX -> RebaseFixup (PrimOf p) wX wX)
-> RebaseName wX wX
-> RebaseItem p wX wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RebaseName wX wX -> RebaseFixup (PrimOf p) wX wX
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup) (Sealed (RebaseName wX) -> Sealed (RebaseItem p wX))
-> Parser ByteString (Sealed (RebaseName wX))
-> Parser (Sealed (RebaseItem p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser ByteString (Sealed (RebaseName wX))
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 :: 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 <- Parser (Sealed (q wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
                             ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
")")
                             Sealed (q wX) -> Parser (Sealed (q wX))
forall (m :: * -> *) a. Monad m => a -> m a
return Sealed (q wX)
res