module Darcs.Patch.Prim.WithName
( PrimWithName(..)
) where
import Darcs.Prelude
import Darcs.Patch.Annotate ( Annotate(..) )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Ident
( Ident(..)
, PatchId
, SignedId(..)
, StorableId(..)
)
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Prim.Class ( PrimApply(..), PrimDetails(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Merge ( CleanMerge(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Repair ( RepairToFL(..) )
import Darcs.Patch.Show
( ShowPatchBasic(..)
, ShowPatch(..)
, ShowContextPatch(..)
)
import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims )
import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered ( mapFL_FL, (:>)(..), (:\/:)(..), (:/\:)(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )
import Darcs.Util.Printer
data PrimWithName name p wX wY =
PrimWithName { forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> name
wnName :: !name, forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch :: !(p wX wY) }
type instance PatchId (PrimWithName name p) = name
instance SignedId name => Ident (PrimWithName name p) where
ident :: forall wX wY.
PrimWithName name p wX wY -> PatchId (PrimWithName name p)
ident = PrimWithName name p wX wY -> name
PrimWithName name p wX wY -> PatchId (PrimWithName name p)
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> name
wnName
instance (Eq name, Eq2 p) => Eq2 (PrimWithName name p) where
PrimWithName name
i p wA wB
p =\/= :: forall wA wB wC.
PrimWithName name p wA wB
-> PrimWithName name p wA wC -> EqCheck wB wC
=\/= PrimWithName name
j p wA wC
q
| name
i name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
j, EqCheck wB wC
IsEq <- p wA wB
p p wA wB -> p wA wC -> EqCheck wB wC
forall wA wB wC. p wA wB -> p wA wC -> EqCheck wB wC
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= p wA wC
q = EqCheck wB wB
EqCheck wB wC
forall wA. EqCheck wA wA
IsEq
| Bool
otherwise = EqCheck wB wC
forall wA wB. EqCheck wA wB
NotEq
instance (Invert p, SignedId name) => Invert (PrimWithName name p) where
invert :: forall wX wY.
PrimWithName name p wX wY -> PrimWithName name p wY wX
invert (PrimWithName name
i p wX wY
p) = name -> p wY wX -> PrimWithName name p wY wX
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName (name -> name
forall a. SignedId a => a -> a
invertId name
i) (p wX wY -> p wY wX
forall wX wY. p wX wY -> p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert p wX wY
p)
instance PatchInspect p => PatchInspect (PrimWithName name p) where
listTouchedFiles :: forall wX wY. PrimWithName name p wX wY -> [AnchoredPath]
listTouchedFiles = p wX wY -> [AnchoredPath]
forall wX wY. p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles (p wX wY -> [AnchoredPath])
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
hunkMatches :: forall wX wY.
(ByteString -> Bool) -> PrimWithName name p wX wY -> Bool
hunkMatches ByteString -> Bool
m = (ByteString -> Bool) -> p wX wY -> Bool
forall wX wY. (ByteString -> Bool) -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
m (p wX wY -> Bool)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance (Show2 p, Show name) => Show (PrimWithName name p wX wY) where
showsPrec :: Int -> PrimWithName name p wX wY -> ShowS
showsPrec Int
d (PrimWithName name
i p wX wY
p) =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"PrimWithName "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> name -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) name
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> p wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) p wX wY
p
instance (Show2 p, Show name) => Show1 (PrimWithName name p wX)
instance (Show2 p, Show name) => Show2 (PrimWithName name p)
instance Apply p => Apply (PrimWithName name p) where
type ApplyState (PrimWithName name p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
PrimWithName name p wX wY -> m ()
apply = p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState p) m =>
p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply (p wX wY -> m ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
PrimWithName name p wX wY -> m ()
unapply = p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState p) m =>
p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply (p wX wY -> m ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance PatchListFormat (PrimWithName name p)
instance Apply p => RepairToFL (PrimWithName name p) where
applyAndTryToFixFL :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
PrimWithName name p wX wY
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
applyAndTryToFixFL PrimWithName name p wX wY
p = PrimWithName name p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
PrimWithName name p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PrimWithName name p wX wY
p m ()
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (String, FL (PrimWithName name p) wX wY)
-> m (Maybe (String, FL (PrimWithName name p) wX wY))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL (PrimWithName name p) wX wY)
forall a. Maybe a
Nothing
instance Annotate p => Annotate (PrimWithName name p) where
annotate :: forall wX wY. PrimWithName name p wX wY -> AnnotatedM ()
annotate = p wX wY -> AnnotatedM ()
forall wX wY. p wX wY -> AnnotatedM ()
forall (p :: * -> * -> *) wX wY.
Annotate p =>
p wX wY -> AnnotatedM ()
annotate (p wX wY -> AnnotatedM ())
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> AnnotatedM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance IsHunk p => IsHunk (PrimWithName name p) where
isHunk :: forall wX wY.
PrimWithName name p wX wY
-> Maybe (FileHunk (ObjectIdOfPatch (PrimWithName name p)) wX wY)
isHunk = p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
forall wX wY. p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
isHunk (p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY))
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance PrimApply p => PrimApply (PrimWithName name p) where
applyPrimFL :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
FL (PrimWithName name p) wX wY -> m ()
applyPrimFL = FL p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState p) m =>
FL p wX wY -> m ()
forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL (FL p wX wY -> m ())
-> (FL (PrimWithName name p) wX wY -> FL p wX wY)
-> FL (PrimWithName name p) wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. PrimWithName name p wW wY -> p wW wY)
-> FL (PrimWithName name 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 PrimWithName name p wW wY -> p wW wY
forall wW wY. PrimWithName name p wW wY -> p wW wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance PrimDetails p => PrimDetails (PrimWithName name p) where
summarizePrim :: forall wX wY. PrimWithName name p wX wY -> [SummDetail]
summarizePrim = p wX wY -> [SummDetail]
forall wX wY. p wX wY -> [SummDetail]
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> [SummDetail]
summarizePrim (p wX wY -> [SummDetail])
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> [SummDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance (SignedId name, Commute p) => Commute (PrimWithName name p) where
commute :: forall wX wY.
(:>) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
commute (PrimWithName name
i1 p wX wZ
p1 :> PrimWithName name
i2 p wZ wY
p2)
| name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
i2 = String
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. HasCallStack => String -> a
error String
"internal error: trying to commute identical patches"
| name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name -> name
forall a. SignedId a => a -> a
invertId name
i2 = Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. Maybe a
Nothing
| Bool
otherwise = do
p wX wZ
p2' :> p wZ wY
p1' <- (:>) p p wX wY -> Maybe ((:>) p p wX wY)
forall wX wY. (:>) p p wX wY -> Maybe ((:>) p p wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (p wX wZ
p1 p wX wZ -> p wZ wY -> (:>) p p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p2)
(:>) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:>) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (name -> p wX wZ -> PrimWithName name p wX wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' PrimWithName name p wX wZ
-> PrimWithName name p wZ wY
-> (:>) (PrimWithName name p) (PrimWithName name p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> name -> p wZ wY -> PrimWithName name p wZ wY
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i1 p wZ wY
p1')
instance (SignedId name, CleanMerge p) => CleanMerge (PrimWithName name p) where
cleanMerge :: forall wX wY.
(:\/:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
cleanMerge (PrimWithName name
i1 p wZ wX
p1 :\/: PrimWithName name
i2 p wZ wY
p2)
| name
i1 name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
i2 = String
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. HasCallStack => String -> a
error String
"cannot cleanMerge identical patches"
| Bool
otherwise = do
p wX wZ
p2' :/\: p wY wZ
p1' <- (:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
forall wX wY. (:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (p wZ wX
p1 p wZ wX -> p wZ wY -> (:\/:) p p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: p wZ wY
p2)
(:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe
((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY))
-> (:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
-> Maybe ((:/\:) (PrimWithName name p) (PrimWithName name p) wX wY)
forall a b. (a -> b) -> a -> b
$ name -> p wX wZ -> PrimWithName name p wX wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' PrimWithName name p wX wZ
-> PrimWithName name p wY wZ
-> (:/\:) (PrimWithName name p) (PrimWithName name p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: name -> p wY wZ -> PrimWithName name p wY wZ
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i1 p wY wZ
p1'
instance (StorableId name, ReadPatch p) => ReadPatch (PrimWithName name p) where
readPatch' :: forall wX. Parser (Sealed (PrimWithName name p wX))
readPatch' = do
name
name <- Parser name
forall a. StorableId a => Parser a
readId
Sealed p wX wX
p <- Parser (Sealed (p wX))
forall wX. Parser (Sealed (p wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
Sealed (PrimWithName name p wX)
-> Parser (Sealed (PrimWithName name p wX))
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimWithName name p wX wX -> Sealed (PrimWithName name p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (name -> p wX wX -> PrimWithName name p wX wX
forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
name p wX wX
p))
instance (StorableId name, ShowPatchBasic p) => ShowPatchBasic (PrimWithName name p) where
showPatch :: forall wX wY. ShowPatchFor -> PrimWithName name p wX wY -> Doc
showPatch ShowPatchFor
use (PrimWithName name
name p wX wY
p) = ShowPatchFor -> name -> Doc
forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> Doc
$$ ShowPatchFor -> p wX wY -> Doc
forall wX wY. ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
use p wX wY
p
instance (StorableId name, PrimDetails p, ShowPatchBasic p) => ShowPatch (PrimWithName name p) where
summary :: forall wX wY. PrimWithName name p wX wY -> Doc
summary = p wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> Doc
plainSummaryPrim (p wX wY -> Doc)
-> (PrimWithName name p wX wY -> p wX wY)
-> PrimWithName name p wX wY
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimWithName name p wX wY -> p wX wY
forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
summaryFL :: forall wX wY. FL (PrimWithName name p) wX wY -> Doc
summaryFL = Bool -> FL (PrimWithName name p) wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
Bool -> FL prim wX wY -> Doc
plainSummaryPrims Bool
False
thing :: forall wX wY. PrimWithName name p wX wY -> String
thing PrimWithName name p wX wY
_ = String
"change"
instance (StorableId name, ShowContextPatch p) => ShowContextPatch (PrimWithName name p) where
showPatchWithContextAndApply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
ShowPatchFor -> PrimWithName name p wX wY -> m Doc
showPatchWithContextAndApply ShowPatchFor
use (PrimWithName name
name p wX wY
p) = do
Doc
r <- ShowPatchFor -> p wX wY -> m Doc
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState p) m =>
ShowPatchFor -> p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showPatchWithContextAndApply ShowPatchFor
use p wX wY
p
Doc -> m Doc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> name -> Doc
forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> Doc
$$ Doc
r