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(..)
, IdEq2(..)
)
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Prim.Class ( PrimApply(..), PrimClassify(..), 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 = forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> name
wnName
instance (SignedId name, Eq2 p) => IdEq2 (PrimWithName name p)
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 forall a. Eq a => a -> a -> Bool
== name
j, EqCheck wB wC
IsEq <- p wA wB
p forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= p wA wC
q = forall wA. EqCheck wA wA
IsEq
| Bool
otherwise = 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) = forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName (forall a. SignedId a => a -> a
invertId name
i) (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 = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> Int
appPrec)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"PrimWithName "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec forall a. Num a => a -> a -> a
+ Int
1) name
i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec 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 = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PrimWithName name p wX wY
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
instance Annotate p => Annotate (PrimWithName name p) where
annotate :: forall wX wY. PrimWithName name p wX wY -> AnnotatedM ()
annotate = forall (p :: * -> * -> *) wX wY.
Annotate p =>
p wX wY -> AnnotatedM ()
annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 wX wY)
isHunk = forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
instance PrimClassify p => PrimClassify (PrimWithName name p) where
primIsAddfile :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsAddfile = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAddfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsRmfile :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsRmfile = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsRmfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsAdddir :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsAdddir = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAdddir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsRmdir :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsRmdir = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsRmdir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsHunk :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsHunk = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsMove :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsMove = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsMove forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsBinary :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsBinary = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsTokReplace :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsTokReplace = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsTokReplace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
primIsSetpref :: forall wX wY. PrimWithName name p wX wY -> Bool
primIsSetpref = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsSetpref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (p :: * -> * -> *) wX wY.
PrimWithName name p wX wY -> p wX wY
wnPatch
is_filepatch :: forall wX wY. PrimWithName name p wX wY -> Maybe AnchoredPath
is_filepatch = forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Maybe AnchoredPath
is_filepatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> [SummDetail]
summarizePrim forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== name
i2 = forall a. HasCallStack => String -> a
error String
"internal error: trying to commute identical patches"
| name
i1 forall a. Eq a => a -> a -> Bool
== forall a. SignedId a => a -> a
invertId name
i2 = forall a. Maybe a
Nothing
| Bool
otherwise = do
p wX wZ
p2' :> p wZ wY
p1' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (p wX wZ
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p2)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 forall a. Eq a => a -> a -> Bool
== name
i2 = forall a. HasCallStack => String -> a
error String
"cannot cleanMerge identical patches"
| Bool
otherwise = do
p wX wZ
p2' :/\: p wY wZ
p1' <- forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (p wZ wX
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: p wZ wY
p2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name (p :: * -> * -> *) wX wY.
name -> p wX wY -> PrimWithName name p wX wY
PrimWithName name
i2 p wX wZ
p2' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: 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 <- forall a. StorableId a => Parser a
readId
Sealed p wX wX
p <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (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) = forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> 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 = forall (prim :: * -> * -> *) wX wY.
PrimDetails prim =>
prim wX wY -> Doc
plainSummaryPrim forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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
showContextPatch :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PrimWithName name p)) m =>
ShowPatchFor -> PrimWithName name p wX wY -> m Doc
showContextPatch ShowPatchFor
use (PrimWithName name
name p wX wY
p) = do
Doc
r <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
use p wX wY
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. StorableId a => ShowPatchFor -> a -> Doc
showId ShowPatchFor
use name
name Doc -> Doc -> Doc
$$ Doc
r