{- | Formal inverses for patches that aren't really invertible. Note that
most the mixed {'Fwd','Rev'} cases for 'Commute' and 'Eq2' are just errors.
-}
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 ((:>)(..))

-- | Wrapper type to allow formal inversion of patches which aren't really
-- invertible.
data Invertible p wX wY where
   Fwd :: p wX wY -> Invertible p wX wY
   Rev :: p wX wY -> Invertible p wY wX

-- | Wrap a patch to make it (formally) 'Invertible'. The result is initially
-- positive i.e. 'Fwd'.
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

-- | Get the underlying patch from an 'Invertible', assuming (as a precondition)
-- that it is positive i.e. '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"

-- | Run a function on the patch inside an 'Invertible'. The function has to be
-- parametric in the witnesses, so we can run it with both a 'Fwd' and a 'Rev'
-- patch.
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
  -- note these are only used for display
  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)