module Darcs.Patch.Invertible
( Invertible
, mkInvertible
, fromPositiveInvertible
, withInvertible
) where
import Darcs.Prelude
import Darcs.Patch.CommuteFn ( invertCommuter )
import Darcs.Patch.Ident
( Ident(..), PatchId, SignedId(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.RepoPatch
( Apply(..)
, Commute(..)
, Eq2(..)
, PrimPatchBase(..)
, PatchInspect(..)
, ShowContextPatch(..)
, ShowPatch(..)
, ShowPatchBasic(..)
)
import Darcs.Patch.Show ( ShowPatchFor(..) )
import Darcs.Patch.Witnesses.Ordered ((:>)(..))
data Invertible p wX wY where
Fwd :: p wX wY -> Invertible p wX wY
Rev :: p wX wY -> Invertible p wY wX
mkInvertible :: p wX wY -> Invertible p wX wY
mkInvertible :: forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
mkInvertible = forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
Fwd
fromPositiveInvertible :: Invertible p wX wY -> p wX wY
fromPositiveInvertible :: forall (p :: * -> * -> *) wX wY. Invertible p wX wY -> p wX wY
fromPositiveInvertible (Fwd p wX wY
p) = p wX wY
p
fromPositiveInvertible (Rev p wY wX
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"precondition of fromPositiveInvertible"
withInvertible :: (forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible :: forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible forall wA wB. p wA wB -> r
f (Fwd p wX wY
p) = forall wA wB. p wA wB -> r
f p wX wY
p
withInvertible forall wA wB. p wA wB -> r
f (Rev p wY wX
p) = forall wA wB. p wA wB -> r
f p wY wX
p
instance Invert (Invertible p) where
invert :: forall wX wY. Invertible p wX wY -> Invertible p wY wX
invert (Fwd p wX wY
p) = forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wY wX
Rev p wX wY
p
invert (Rev p wY wX
p) = forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
Fwd p wY wX
p
instance Commute p => Commute (Invertible p) where
commute :: forall wX wY.
(:>) (Invertible p) (Invertible p) wX wY
-> Maybe ((:>) (Invertible p) (Invertible p) wX wY)
commute (Fwd p wX wZ
p :> Fwd p wZ wY
q) = do
p wX wZ
q' :> p wZ wY
p' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (p wX wZ
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
q)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
Fwd p wX wZ
q' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY. p wX wY -> Invertible p wX wY
Fwd p wZ wY
p')
commute pair :: (:>) (Invertible p) (Invertible p) wX wY
pair@(Rev p wZ wX
_ :> Rev p wY wZ
_) = forall (p :: * -> * -> *) (q :: * -> * -> *).
(Invert p, Invert q) =>
CommuteFn p q -> CommuteFn q p
invertCommuter forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (:>) (Invertible p) (Invertible p) wX wY
pair
commute (:>) (Invertible p) (Invertible p) wX wY
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"cannote commute mixed Fwd/Rev"
instance Eq2 p => Eq2 (Invertible p) where
Fwd p wA wB
p =\/= :: forall wA wB wC.
Invertible p wA wB -> Invertible p wA wC -> EqCheck wB wC
=\/= Fwd p wA wC
q = p wA wB
p forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= p wA wC
q
Rev p wB wA
p =\/= Rev p wC wA
q = p wB wA
p forall (p :: * -> * -> *) wA wC wB.
Eq2 p =>
p wA wC -> p wB wC -> EqCheck wA wB
=/\= p wC wA
q
Invertible p wA wB
_ =\/= Invertible p wA wC
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"cannot compare mixed Fwd/Rev"
instance Apply p => Apply (Invertible p) where
type ApplyState (Invertible p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Invertible p)) m =>
Invertible p wX wY -> m ()
apply (Fwd p wX wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
p
apply (Rev p wY wX
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply p wY wX
p
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Invertible p)) m =>
Invertible p wX wY -> m ()
unapply (Fwd p wX wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply p wX wY
p
unapply (Rev p wY wX
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wY wX
p
data InvertibleId ident = InvertibleId Bool ident
deriving (InvertibleId ident -> InvertibleId ident -> Bool
forall ident.
Eq ident =>
InvertibleId ident -> InvertibleId ident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvertibleId ident -> InvertibleId ident -> Bool
$c/= :: forall ident.
Eq ident =>
InvertibleId ident -> InvertibleId ident -> Bool
== :: InvertibleId ident -> InvertibleId ident -> Bool
$c== :: forall ident.
Eq ident =>
InvertibleId ident -> InvertibleId ident -> Bool
Eq, InvertibleId ident -> InvertibleId ident -> Bool
InvertibleId ident -> InvertibleId ident -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ident}. Ord ident => Eq (InvertibleId ident)
forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Bool
forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Ordering
forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> InvertibleId ident
min :: InvertibleId ident -> InvertibleId ident -> InvertibleId ident
$cmin :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> InvertibleId ident
max :: InvertibleId ident -> InvertibleId ident -> InvertibleId ident
$cmax :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> InvertibleId ident
>= :: InvertibleId ident -> InvertibleId ident -> Bool
$c>= :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Bool
> :: InvertibleId ident -> InvertibleId ident -> Bool
$c> :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Bool
<= :: InvertibleId ident -> InvertibleId ident -> Bool
$c<= :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Bool
< :: InvertibleId ident -> InvertibleId ident -> Bool
$c< :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Bool
compare :: InvertibleId ident -> InvertibleId ident -> Ordering
$ccompare :: forall ident.
Ord ident =>
InvertibleId ident -> InvertibleId ident -> Ordering
Ord)
instance Ord ident => SignedId (InvertibleId ident) where
positiveId :: InvertibleId ident -> Bool
positiveId (InvertibleId Bool
inverted ident
_) = Bool
inverted
invertId :: InvertibleId ident -> InvertibleId ident
invertId (InvertibleId Bool
inverted ident
theid) =
forall ident. Bool -> ident -> InvertibleId ident
InvertibleId (Bool -> Bool
not Bool
inverted) ident
theid
type instance PatchId (Invertible p) = InvertibleId (PatchId p)
instance Ident p => Ident (Invertible p) where
ident :: forall wX wY. Invertible p wX wY -> PatchId (Invertible p)
ident (Fwd p wX wY
p) = forall ident. Bool -> ident -> InvertibleId ident
InvertibleId Bool
False (forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
p)
ident (Rev p wY wX
p) = forall ident. Bool -> ident -> InvertibleId ident
InvertibleId Bool
True (forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wY wX
p)
instance PatchInspect p => PatchInspect (Invertible p) where
listTouchedFiles :: forall wX wY. Invertible p wX wY -> [AnchoredPath]
listTouchedFiles (Fwd p wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
p
listTouchedFiles (Rev p wY wX
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wY wX
p
hunkMatches :: forall wX wY. (ByteString -> Bool) -> Invertible p wX wY -> Bool
hunkMatches ByteString -> Bool
f (Fwd p wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f p wX wY
p
hunkMatches ByteString -> Bool
f (Rev p wY wX
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f p wY wX
p
instance PrimPatchBase p => PrimPatchBase (Invertible p) where
type PrimOf (Invertible p) = PrimOf p
instance ShowPatchBasic p => ShowPatchBasic (Invertible p) where
showPatch :: forall wX wY. ShowPatchFor -> Invertible p wX wY -> Doc
showPatch ShowPatchFor
ForStorage = forall a. HasCallStack => [Char] -> a
error [Char]
"Invertible patches must not be stored"
showPatch ShowPatchFor
ForDisplay = forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay)
instance ShowPatch p => ShowPatch (Invertible p) where
description :: forall wX wY. Invertible p wX wY -> Doc
description = forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description
summary :: forall wX wY. Invertible p wX wY -> Doc
summary = forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary
content :: forall wX wY. Invertible p wX wY -> Doc
content = forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
content
instance ShowContextPatch p => ShowContextPatch (Invertible p) where
showContextPatch :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Invertible p)) m =>
ShowPatchFor -> Invertible p wX wY -> m Doc
showContextPatch ShowPatchFor
ForStorage = forall a. HasCallStack => [Char] -> a
error [Char]
"Invertible patches must not be stored"
showContextPatch ShowPatchFor
ForDisplay = forall (p :: * -> * -> *) r wX wY.
(forall wA wB. p wA wB -> r) -> Invertible p wX wY -> r
withInvertible (forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
ForDisplay)