{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Named.Wrapped
( WrappedNamed(..)
, fromRebasing
) where
import Darcs.Prelude
import Control.Applicative ( (<|>) )
import Data.Coerce ( coerce )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId )
import Darcs.Patch.Format ( PatchListFormat(..), ListFormat )
import Darcs.Patch.Info ( PatchInfo, showPatchInfo )
import Darcs.Patch.FromPrim ( FromPrim, PrimPatchBase(..) )
import Darcs.Patch.Named ( Named(..), patch2patchinfo )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Rebase.Suspended
( Suspended(..)
, addFixupsToSuspended
, removeFixupsFromSuspended
)
import Darcs.Patch.RepoPatch ( RepoPatch )
import Darcs.Patch.RepoType
( RepoType(..), IsRepoType(..), SRepoType(..)
, RebaseType(..), SRebaseType(..)
)
import Darcs.Patch.Show ( ShowPatchBasic(..) )
import Darcs.Patch.Witnesses.Sealed ( mapSeal )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Patch.Witnesses.Ordered
( FL(..), mapFL_FL, (:>)(..)
)
data WrappedNamed (rt :: RepoType) p wX wY where
NormalP :: !(Named p wX wY) -> WrappedNamed rt p wX wY
RebaseP
:: (PrimPatchBase p, FromPrim p, Effect p)
=> !PatchInfo
-> !(Suspended p wX wX)
-> WrappedNamed ('RepoType 'IsRebase) p wX wX
deriving instance Show2 p => Show (WrappedNamed rt p wX wY)
instance Show2 p => Show1 (WrappedNamed rt p wX)
instance Show2 p => Show2 (WrappedNamed rt p)
fromRebasing :: WrappedNamed rt p wX wY -> Named p wX wY
fromRebasing :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> Named p wX wY
fromRebasing (NormalP Named p wX wY
n) = Named p wX wY
n
fromRebasing (RebaseP {}) = forall a. HasCallStack => String -> a
error String
"internal error: found rebasing internal patch"
instance PrimPatchBase p => PrimPatchBase (WrappedNamed rt p) where
type PrimOf (WrappedNamed rt p) = PrimOf p
type instance PatchId (WrappedNamed rt p) = PatchInfo
instance Ident (WrappedNamed rt p) where
ident :: forall wX wY.
WrappedNamed rt p wX wY -> PatchId (WrappedNamed rt p)
ident (NormalP Named p wX wY
p) = forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named p wX wY
p
ident (RebaseP PatchInfo
name Suspended p wX wX
_) = PatchInfo
name
instance PatchListFormat (WrappedNamed rt p)
instance (ShowPatchBasic p, PatchListFormat p)
=> ShowPatchBasic (WrappedNamed rt p) where
showPatch :: forall wX wY. ShowPatchFor -> WrappedNamed rt p wX wY -> Doc
showPatch ShowPatchFor
f (NormalP Named p wX wY
n) = forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Named p wX wY
n
showPatch ShowPatchFor
f (RebaseP PatchInfo
i Suspended p wX wX
s) = ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
i forall a. Semigroup a => a -> a -> a
<> forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Suspended p wX wX
s
data ReadRebasing p wX wY where
ReadNormal :: p wX wY -> ReadRebasing p wX wY
ReadSuspended :: Suspended p wX wX -> ReadRebasing p wX wX
instance ( ReadPatch p, PrimPatchBase p, FromPrim p, Effect p, PatchListFormat p
, RepoPatch p, IsRepoType rt
) => ReadPatch (WrappedNamed rt p) where
readPatch' :: forall wX. Parser (Sealed (WrappedNamed rt p wX))
readPatch' =
case forall (rt :: RepoType). IsRepoType rt => SRepoType rt
singletonRepoType :: SRepoType rt of
SRepoType SRebaseType rebaseType
SIsRebase ->
let wrapNamed :: Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
wrapNamed :: forall wX wY.
Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
wrapNamed (NamedP PatchInfo
i [] (ReadSuspended Suspended p wX wX
s :>: FL (ReadRebasing p) wY wY
NilFL))
= forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i Suspended p wX wX
s
wrapNamed (NamedP PatchInfo
i [PatchInfo]
deps FL (ReadRebasing p) wX wY
ps) = forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL 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 wX
_) = forall a. HasCallStack => String -> a
error String
"unexpected suspended patch"
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX wY.
Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
wrapNamed) forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
SRepoType rt
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP) forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
instance PatchListFormat p => PatchListFormat (ReadRebasing p) where
patchListFormat :: ListFormat (ReadRebasing p)
patchListFormat = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p)
instance (ReadPatch p, PatchListFormat p, PrimPatchBase p, RepoPatch p) => ReadPatch (ReadRebasing p) where
readPatch' :: forall wX. Parser (Sealed (ReadRebasing p wX))
readPatch' =
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX wY. Suspended p wX wY -> ReadRebasing p wX wY
toSuspended forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
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. p wX wY -> ReadRebasing p wX wY
ReadNormal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
where
toSuspended :: Suspended p wX wY -> ReadRebasing p wX wY
toSuspended :: forall wX wY. Suspended p wX wY -> ReadRebasing p wX wY
toSuspended (Items FL (RebaseChange (PrimOf p)) wX wY
ps) = forall (p :: * -> * -> *) wX.
Suspended p wX wX -> ReadRebasing p wX wX
ReadSuspended (forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX wX
Items FL (RebaseChange (PrimOf p)) wX wY
ps)
instance Apply p => Apply (WrappedNamed rt p) where
type ApplyState (WrappedNamed rt p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (WrappedNamed rt p)) m =>
WrappedNamed rt p wX wY -> m ()
apply (NormalP Named p wX wY
n) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Named p wX wY
n
apply (RebaseP PatchInfo
_ Suspended p wX wX
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (WrappedNamed rt p)) m =>
WrappedNamed rt p wX wY -> m ()
unapply (NormalP Named p wX wY
n) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply Named p wX wY
n
unapply (RebaseP PatchInfo
_ Suspended p wX wX
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Commute p => Commute (WrappedNamed rt p) where
commute :: forall wX wY.
(:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
-> Maybe ((:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY)
commute (NormalP Named p wX wZ
n1 :> NormalP Named p wZ wY
n2) = do
Named p wX wZ
n2' :> Named p wZ wY
n1' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Named p wX wZ
n1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wZ wY
n2)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wZ
n2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wY
n1')
commute (RebaseP PatchInfo
i1 Suspended p wX wX
s1 :> RebaseP PatchInfo
i2 Suspended p wZ wZ
s2) =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 Suspended p wZ wZ
s2 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 Suspended p wX wX
s1)
commute (NormalP Named p wX wZ
n1 :> RebaseP PatchInfo
i2 Suspended p wZ wZ
s2) =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 (forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wY wY -> Suspended p wX wX
addFixupsToSuspended Named p wX wZ
n1 Suspended p wZ wZ
s2) forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wZ
n1)
commute (RebaseP PatchInfo
i1 Suspended p wX wX
s1 :> NormalP Named p wZ wY
n2) =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wY
n2 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 (forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
removeFixupsFromSuspended Named p wZ wY
n2 Suspended p wX wX
s1))