Safe Haskell | None |
---|---|
Language | Haskell2010 |
Darcs.Patch.RepoPatch
Synopsis
- type RepoPatch p = (AnnotateRP p, Apply p, ApplyState p ~ ApplyState (PrimOf p), Check p, Commute p, Conflict p, Effect p, Eq2 p, FromPrim p, IsHunk p, IsHunk (PrimOf p), Merge p, PatchInspect p, PatchListFormat p, PrimPatchBase p, ReadPatch p, RepairToFL p, ShowContextPatch p, ShowPatch p, Summary p, ToPrim p, Unwind p)
- type AnnotateRP p = (Annotate (PrimOf p), Invert (PrimOf p), Effect p)
- class Apply p where
- type ApplyState p :: (* -> *) -> *
- apply :: ApplyMonad (ApplyState p) m => p wX wY -> m ()
- unapply :: ApplyMonad (ApplyState p) m => p wX wY -> m ()
- class Check p where
- isInconsistent :: p wX wY -> Maybe Doc
- class Commute p where
- class Conflict p where
- resolveConflicts :: RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
- class Effect p where
- class Eq2 p where
- class FromPrim p where
- class IsHunk p where
- class CleanMerge p => Merge p where
- class PatchInspect p where
- listTouchedFiles :: p wX wY -> [AnchoredPath]
- hunkMatches :: (ByteString -> Bool) -> p wX wY -> Bool
- class PatchListFormat p where
- class PrimPatch (PrimOf p) => PrimPatchBase p where
- type PrimOf (p :: * -> * -> *) :: * -> * -> *
- class ReadPatch p where
- readPatch' :: Parser (Sealed (p wX))
- class Apply p => RepairToFL p where
- applyAndTryToFixFL :: ApplyMonad (ApplyState p) m => p wX wY -> m (Maybe (String, FL p wX wY))
- class ShowPatchBasic p => ShowContextPatch p where
- showContextPatch :: ApplyMonad (ApplyState p) m => ShowPatchFor -> p wX wY -> m Doc
- class ShowPatchBasic p => ShowPatch p where
- class ShowPatchBasic p where
- showPatch :: ShowPatchFor -> p wX wY -> Doc
- class Summary p where
- conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)]
- class ToPrim p where
- class Unwind p where
- fullUnwind :: p wX wY -> Unwound (PrimOf p) wX wY
Documentation
type RepoPatch p = (AnnotateRP p, Apply p, ApplyState p ~ ApplyState (PrimOf p), Check p, Commute p, Conflict p, Effect p, Eq2 p, FromPrim p, IsHunk p, IsHunk (PrimOf p), Merge p, PatchInspect p, PatchListFormat p, PrimPatchBase p, ReadPatch p, RepairToFL p, ShowContextPatch p, ShowPatch p, Summary p, ToPrim p, Unwind p) Source #
type AnnotateRP p = (Annotate (PrimOf p), Invert (PrimOf p), Effect p) Source #
This constraint expresses what is needed for a repo patch to support the high-level interface to annotation (currently annotateFile and annotateDirectory)
Minimal complete definition
Associated Types
type ApplyState p :: (* -> *) -> * Source #
Methods
apply :: ApplyMonad (ApplyState p) m => p wX wY -> m () Source #
unapply :: ApplyMonad (ApplyState p) m => p wX wY -> m () Source #
unapply :: (ApplyMonad (ApplyState p) m, Invert p) => p wX wY -> m () Source #
Instances
Minimal complete definition
Nothing
Methods
isInconsistent :: p wX wY -> Maybe Doc Source #
Instances
Check p => Check (RL p) Source # | |
Defined in Darcs.Patch.Repair | |
Check p => Check (FL p) Source # | |
Defined in Darcs.Patch.Repair | |
Check (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Core Methods isInconsistent :: RepoPatchV1 prim wX wY -> Maybe Doc Source # | |
PrimPatch prim => Check (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods isInconsistent :: RepoPatchV2 prim wX wY -> Maybe Doc Source # | |
Check p => Check (Named p) Source # | |
Defined in Darcs.Patch.Named | |
PrimPatch prim => Check (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core Methods isInconsistent :: RepoPatchV3 name prim wX wY -> Maybe Doc Source # |
class Commute p where Source #
Commute represents things that can be (possibly) commuted.
Instances should obey the following laws:
- Symmetry
commute (p:>q) == Just (q':>p') <=> commute (q':>p') == Just (p':>q)
- If an instance
exists, thenInvert
p
commute (p:>q) == Just (q':>p') <=> commute (invert q:>invert p) == Just (invert p':>invert q')
- The more general Square-Commute law
commute (p:>q) == Just (q':>p') => commute (invert p:>q') == Just (q:>invert p')
is required to hold only for primitive patches, i.e. if there is no
instance
, because together with Merge
pmerge
it implies that
any two patches commute.
Instances
class Conflict p where Source #
Methods
resolveConflicts :: RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY] Source #
The first parameter is a context containing all patches
preceding the ones for which we want to calculate the conflict
resolution, which is the second parameter.
Each element of the result list represents the resolution
of one maximal set of transitively conflicting alternatives,
in other words, a connected subset of the conflict graph.
But the elements themselves must not conflict with each other,
guaranteeing that they can be cleanly merged into a single FL
of prims.
Instances
PrimPatch prim => Conflict (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Commute Methods resolveConflicts :: RL (RepoPatchV1 prim) wO wX -> RL (RepoPatchV1 prim) wX wY -> [ConflictDetails (PrimOf (RepoPatchV1 prim)) wY] Source # | |
PrimPatch prim => Conflict (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods resolveConflicts :: RL (RepoPatchV2 prim) wO wX -> RL (RepoPatchV2 prim) wX wY -> [ConflictDetails (PrimOf (RepoPatchV2 prim)) wY] Source # | |
(Commute p, Conflict p) => Conflict (Named p) Source # | This instance takes care of handling the interaction between conflict
resolution and explicit dependencies. By definition, a conflict counts as
resolved if another patch depends on it. This principle extends to explicit
dependencies between This means we count any patch inside a |
Defined in Darcs.Patch.Named Methods resolveConflicts :: RL (Named p) wO wX -> RL (Named p) wX wY -> [ConflictDetails (PrimOf (Named p)) wY] Source # | |
(Commute p, Conflict p) => Conflict (PatchInfoAnd rt p) Source # | |
Defined in Darcs.Patch.PatchInfoAnd Methods resolveConflicts :: RL (PatchInfoAnd rt p) wO wX -> RL (PatchInfoAnd rt p) wX wY -> [ConflictDetails (PrimOf (PatchInfoAnd rt p)) wY] Source # | |
(SignedId name, StorableId name, PrimPatch prim) => Conflict (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Resolution Methods resolveConflicts :: RL (RepoPatchV3 name prim) wO wX -> RL (RepoPatchV3 name prim) wX wY -> [ConflictDetails (PrimOf (RepoPatchV3 name prim)) wY] Source # |
Patches whose concrete effect can be expressed as a list of primitive patches.
A minimal definition would be either of effect
or effectRL
.
Instances
Effect p => Effect (RL p) Source # | |
Effect p => Effect (FL p) Source # | |
PrimPatch prim => Effect (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Commute Methods effect :: RepoPatchV1 prim wX wY -> FL (PrimOf (RepoPatchV1 prim)) wX wY Source # | |
PrimPatch prim => Effect (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods effect :: RepoPatchV2 prim wX wY -> FL (PrimOf (RepoPatchV2 prim)) wX wY Source # | |
Effect p => Effect (Named p) Source # | |
Effect p => Effect (WithDroppedDeps p) Source # | |
Defined in Darcs.Patch.Rebase.Change Methods effect :: WithDroppedDeps p wX wY -> FL (PrimOf (WithDroppedDeps p)) wX wY Source # | |
Effect p => Effect (PatchInfoAndG rt p) Source # | |
Defined in Darcs.Patch.PatchInfoAnd Methods effect :: PatchInfoAndG rt p wX wY -> FL (PrimOf (PatchInfoAndG rt p)) wX wY Source # | |
Effect (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core Methods effect :: RepoPatchV3 name prim wX wY -> FL (PrimOf (RepoPatchV3 name prim)) wX wY Source # |
An witness aware equality class.
A minimal definition defines any one of unsafeCompare
, =\/=
and =/\=
.
Minimal complete definition
Nothing
Methods
unsafeCompare :: p wA wB -> p wC wD -> Bool Source #
It is unsafe to define a class instance via this method, because
if it returns True then the default implementations of =\/=
and =/\=
will coerce the equality of two witnesses.
Calling this method is safe, although =\/=
or =/\=
would be better
choices as it is not usually meaningul to compare two patches that
don't share either a starting or an ending context
(=\/=) :: p wA wB -> p wA wC -> EqCheck wB wC infix 4 Source #
Compare two things with the same starting witness. If the things compare equal, evidence of the ending witnesses being equal will be returned.
(=/\=) :: p wA wC -> p wB wC -> EqCheck wA wB infix 4 Source #
Compare two things with the same ending witness. If the things compare equal, evidence of the starting witnesses being equal will be returned.
Instances
class FromPrim p where Source #
Minimal complete definition
Methods
fromAnonymousPrim :: PrimOf p wX wY -> p wX wY Source #
fromPrim :: PatchId p -> PrimOf p wX wY -> p wX wY Source #
fromPrims :: PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY Source #
fromPrim :: PatchId p ~ () => PatchId p -> PrimOf p wX wY -> p wX wY Source #
fromPrims :: PatchId p ~ () => PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY Source #
Instances
Instances
IsHunk Prim Source # | |
IsHunk Prim Source # | |
IsHunk Prim Source # | |
IsHunk Prim Source # | |
IsHunk prim => IsHunk (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Commute | |
IsHunk prim => IsHunk (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch | |
IsHunk (Named p) Source # | |
IsHunk (RebaseChange prim) Source # | |
Defined in Darcs.Patch.Rebase.Change | |
IsHunk (PatchInfoAndG rt p) Source # | |
Defined in Darcs.Patch.PatchInfoAnd | |
IsHunk p => IsHunk (PrimWithName name p) Source # | |
Defined in Darcs.Patch.Prim.WithName | |
IsHunk prim => IsHunk (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core |
class CleanMerge p => Merge p where Source #
Patches that can always be merged, even if they conflict.
Instances should obey the following laws:
- symmetry
merge (p :\/: q) == q' :/\: p' <=> merge (q :\/: p) == p' :/\: q'
- merge-commute
merge (p :\/: q) == q' :/\: p' ==> commute (p :> q') == Just (q :> p')
that is, the two branches of a merge commute to each other.
- extension
cleanMerge (p :\/: q) == Just (q' :/\: p') => merge (p :\/: q) == q' :/\: p'
that is,
merge
is an extension ofcleanMerge
.
Instances
Merge p => Merge (FL p) Source # | |
PrimPatch prim => Merge (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Commute Methods merge :: (RepoPatchV1 prim :\/: RepoPatchV1 prim) wX wY -> (RepoPatchV1 prim :/\: RepoPatchV1 prim) wX wY Source # | |
PrimPatch prim => Merge (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods merge :: (RepoPatchV2 prim :\/: RepoPatchV2 prim) wX wY -> (RepoPatchV2 prim :/\: RepoPatchV2 prim) wX wY Source # | |
Merge p => Merge (Named p) Source # | |
(PatchId p ~ PatchInfo, Merge p) => Merge (PatchInfoAndG rt p) Source # | |
Defined in Darcs.Patch.PatchInfoAnd Methods merge :: (PatchInfoAndG rt p :\/: PatchInfoAndG rt p) wX wY -> (PatchInfoAndG rt p :/\: PatchInfoAndG rt p) wX wY Source # | |
(SignedId name, StorableId name, PrimPatch prim) => Merge (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core Methods merge :: (RepoPatchV3 name prim :\/: RepoPatchV3 name prim) wX wY -> (RepoPatchV3 name prim :/\: RepoPatchV3 name prim) wX wY Source # |
class PatchInspect p where Source #
Methods
listTouchedFiles :: p wX wY -> [AnchoredPath] Source #
hunkMatches :: (ByteString -> Bool) -> p wX wY -> Bool Source #
Instances
class PatchListFormat p where Source #
Showing and reading lists of patches. This class allows us to control how
lists of patches are formatted on disk. For legacy reasons V1 patches have
their own special treatment (see ListFormat
). Other patch types use the
default format which just puts them in a sequence without separators or any
prelude/epilogue.
This means that 'FL (FL p)' etc would be ambiguous, so there are no instances for 'FL p' or other list types.
Minimal complete definition
Nothing
Methods
patchListFormat :: ListFormat p Source #
Instances
class PrimPatch (PrimOf p) => PrimPatchBase p Source #
Instances
class ReadPatch p where Source #
This class is used to decode patches from their binary representation.
Methods
readPatch' :: Parser (Sealed (p wX)) Source #
Instances
class Apply p => RepairToFL p where Source #
RepairToFL
is implemented by single patches that can be repaired (Prim, Patch, RepoPatchV2)
There is a default so that patch types with no current legacy problems don't need to
have an implementation.
Minimal complete definition
Nothing
Methods
applyAndTryToFixFL :: ApplyMonad (ApplyState p) m => p wX wY -> m (Maybe (String, FL p wX wY)) Source #
Instances
class ShowPatchBasic p => ShowContextPatch p where Source #
Methods
showContextPatch :: ApplyMonad (ApplyState p) m => ShowPatchFor -> p wX wY -> m Doc Source #
showContextPatch is used to add context to a patch, as diff -u does. Thus, it differs from showPatch only for hunks. It is used for instance before putting it into a bundle. As this unified context is not included in patch representation, this requires access to the tree.
Instances
class ShowPatchBasic p => ShowPatch p where Source #
This class is used only for user interaction, not for storage. The default
implementations for description
and content
are suitable only for
PrimPatch
and RepoPatch
types. Logically, description
should default
to mempty
while content
should default to displayPatch
. We define them
the other way around so that showFriendly
gives
reasonable results for all patch types.
Minimal complete definition
Methods
content :: p wX wY -> Doc Source #
description :: p wX wY -> Doc Source #
summary :: p wX wY -> Doc Source #
summaryFL :: FL p wX wY -> Doc Source #
Instances
class ShowPatchBasic p where Source #
Methods
showPatch :: ShowPatchFor -> p wX wY -> Doc Source #
Instances
class Summary p where Source #
Methods
conflictedEffect :: p wX wY -> [IsConflictedPrim (PrimOf p)] Source #
Instances
Instances
ToPrim (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Core Methods toPrim :: RepoPatchV1 prim wX wY -> Maybe (PrimOf (RepoPatchV1 prim) wX wY) Source # | |
ToPrim (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods toPrim :: RepoPatchV2 prim wX wY -> Maybe (PrimOf (RepoPatchV2 prim) wX wY) Source # | |
ToPrim (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core Methods toPrim :: RepoPatchV3 name prim wX wY -> Maybe (PrimOf (RepoPatchV3 name prim) wX wY) Source # |
Methods
fullUnwind :: p wX wY -> Unwound (PrimOf p) wX wY Source #
Get hold of the underlying primitives for a given patch, placed in the context of the patch. If there are conflicts then context patches will be needed.
Instances
PrimPatch prim => Unwind (RepoPatchV1 prim) Source # | |
Defined in Darcs.Patch.V1.Commute Methods fullUnwind :: RepoPatchV1 prim wX wY -> Unwound (PrimOf (RepoPatchV1 prim)) wX wY Source # | |
PrimPatch prim => Unwind (RepoPatchV2 prim) Source # | |
Defined in Darcs.Patch.V2.RepoPatch Methods fullUnwind :: RepoPatchV2 prim wX wY -> Unwound (PrimOf (RepoPatchV2 prim)) wX wY Source # | |
(PrimPatchBase p, Unwind p) => Unwind (Named p) Source # | |
Defined in Darcs.Patch.Named | |
(Invert prim, Commute prim, Eq2 prim) => Unwind (RepoPatchV3 name prim) Source # | |
Defined in Darcs.Patch.V3.Core Methods fullUnwind :: RepoPatchV3 name prim wX wY -> Unwound (PrimOf (RepoPatchV3 name prim)) wX wY Source # |