{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Rebase.Legacy.Wrapped
( WrappedNamed(..)
, fromRebasing
) where
import Darcs.Prelude
import Control.Applicative ( (<|>) )
import Data.Coerce ( coerce )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.Format ( PatchListFormat(..), ListFormat )
import Darcs.Patch.Info ( PatchInfo )
import Darcs.Patch.FromPrim ( FromPrim, PrimPatchBase(..) )
import Darcs.Patch.Named ( Named(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Rebase.Suspended ( Suspended, readSuspended )
import Darcs.Patch.RepoPatch ( RepoPatch )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL_FL )
data WrappedNamed p wX wY where
NormalP :: !(Named p wX wY) -> WrappedNamed p wX wY
RebaseP
:: (PrimPatchBase p, FromPrim p, Effect p)
=> !PatchInfo
-> !(Suspended p wX)
-> WrappedNamed p wX wX
fromRebasing :: WrappedNamed p wX wY -> Named p wX wY
fromRebasing :: forall (p :: * -> * -> *) wX wY.
WrappedNamed p wX wY -> Named p wX wY
fromRebasing (NormalP Named p wX wY
n) = Named p wX wY
n
fromRebasing (RebaseP {}) = [Char] -> Named p wX wY
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: found rebasing internal patch"
data ReadRebasing p wX wY where
ReadNormal :: p wX wY -> ReadRebasing p wX wY
ReadSuspended :: Suspended p wX -> ReadRebasing p wX wX
instance RepoPatch p => ReadPatch (WrappedNamed p) where
readPatch' :: forall wX. Parser (Sealed (WrappedNamed p wX))
readPatch' = (Sealed (Named (ReadRebasing p) wX) -> Sealed (WrappedNamed p wX))
-> Parser ByteString (Sealed (Named (ReadRebasing p) wX))
-> Parser ByteString (Sealed (WrappedNamed p wX))
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall wX. Named (ReadRebasing p) wX wX -> WrappedNamed p wX wX)
-> Sealed (Named (ReadRebasing p) wX) -> Sealed (WrappedNamed p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal Named (ReadRebasing p) wX wX -> WrappedNamed p wX wX
forall wX. Named (ReadRebasing p) wX wX -> WrappedNamed p wX wX
forall wX wY. Named (ReadRebasing p) wX wY -> WrappedNamed p wX wY
wrapNamed) Parser ByteString (Sealed (Named (ReadRebasing p) wX))
forall wX. Parser (Sealed (Named (ReadRebasing p) wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' where
wrapNamed :: Named (ReadRebasing p) wX wY -> WrappedNamed p wX wY
wrapNamed :: forall wX wY. Named (ReadRebasing p) wX wY -> WrappedNamed p wX wY
wrapNamed (NamedP PatchInfo
i [] (ReadSuspended Suspended p wX
s :>: FL (ReadRebasing p) wY wY
NilFL)) = PatchInfo -> Suspended p wX -> WrappedNamed p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo -> Suspended p wX -> WrappedNamed p wX wX
RebaseP PatchInfo
i Suspended p wX
s
wrapNamed (NamedP PatchInfo
i [PatchInfo]
deps FL (ReadRebasing p) wX wY
ps) = Named p wX wY -> WrappedNamed p wX wY
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> WrappedNamed p wX wY
NormalP (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
i [PatchInfo]
deps ((forall wW wY. ReadRebasing p wW wY -> p wW wY)
-> FL (ReadRebasing p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL ReadRebasing p wW wY -> p wW wY
forall wW wY. ReadRebasing p wW wY -> p wW wY
forall {p :: * -> * -> *} {wX} {wY}.
ReadRebasing p wX wY -> p wX wY
unRead FL (ReadRebasing p) wX wY
ps))
unRead :: ReadRebasing p wX wY -> p wX wY
unRead (ReadNormal p wX wY
p) = p wX wY
p
unRead (ReadSuspended Suspended p wX
_) = [Char] -> p wX wY
forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected suspended patch"
instance PatchListFormat p => PatchListFormat (ReadRebasing p) where
patchListFormat :: ListFormat (ReadRebasing p)
patchListFormat = ListFormat p -> ListFormat (ReadRebasing p)
forall a b. Coercible a b => a -> b
coerce (ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p)
instance RepoPatch p => ReadPatch (ReadRebasing p) where
readPatch' :: forall wX. Parser (Sealed (ReadRebasing p wX))
readPatch' =
ReadRebasing p wX wX -> Sealed (ReadRebasing p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (ReadRebasing p wX wX -> Sealed (ReadRebasing p wX))
-> (Suspended p wX -> ReadRebasing p wX wX)
-> Suspended p wX
-> Sealed (ReadRebasing p wX)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Suspended p wX -> ReadRebasing p wX wX
forall (p :: * -> * -> *) wX.
Suspended p wX -> ReadRebasing p wX wX
ReadSuspended (Suspended p wX -> Sealed (ReadRebasing p wX))
-> Parser ByteString (Suspended p wX)
-> Parser ByteString (Sealed (ReadRebasing p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Suspended p wX)
forall (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Suspended p wX)
readSuspended Parser ByteString (Sealed (ReadRebasing p wX))
-> Parser ByteString (Sealed (ReadRebasing p wX))
-> Parser ByteString (Sealed (ReadRebasing 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. p wX wX -> ReadRebasing p wX wX)
-> Sealed (p wX) -> Sealed (ReadRebasing p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal p wX wX -> ReadRebasing p wX wX
forall wX. p wX wX -> ReadRebasing p wX wX
forall (p :: * -> * -> *) wX wY. p wX wY -> ReadRebasing p wX wY
ReadNormal (Sealed (p wX) -> Sealed (ReadRebasing p wX))
-> Parser ByteString (Sealed (p wX))
-> Parser ByteString (Sealed (ReadRebasing p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Sealed (p wX))
forall wX. Parser (Sealed (p wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'