darcs-2.18.5: a distributed, interactive, smart revision control system
Safe HaskellNone
LanguageHaskell2010

Darcs.Patch.Witnesses.Ordered

Synopsis

Directed Types

Darcs patches have a notion of transforming between contexts. This naturally leads us to container types that are "directed" and transform from one context to another.

For example, the swap of names of files x and y could be represented with the following sequence of patches:

 Move x z :> Move y x :> Move z y

or using forward lists, like

 Move x z :>: Move y x :>: Move z y :>: NilFL

data ((a1 :: Type -> Type -> Type) :> (a2 :: Type -> Type -> Type)) wX wY infixr 1 #

Directed Forward Pairs

Constructors

(a1 wX wZ) :> (a2 wZ wY) infixr 1 

Instances

Instances details
Ident p => Ident (p :> p) # 
Instance details

Defined in Darcs.Patch.Ident

Methods

ident :: (p :> p) wX wY -> PatchId (p :> p) #

Invert p => Invert (p :> p) # 
Instance details

Defined in Darcs.Patch.Invert

Methods

invert :: (p :> p) wX wY -> (p :> p) wY wX #

(Eq2 a, Eq2 b) => Eq2 (a :> b) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

unsafeCompare :: (a :> b) wA wB -> (a :> b) wC wD -> Bool #

(=\/=) :: (a :> b) wA wB -> (a :> b) wA wC -> EqCheck wB wC #

(=/\=) :: (a :> b) wA wC -> (a :> b) wB wC -> EqCheck wA wB #

(Show2 a, Show2 b) => Show2 (a :> b) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict2 :: ShowDict ((a :> b) wX wY) #

(Show2 a, Show2 b) => Show1 ((a :> b) wX) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict1 :: Dict (Show ((a :> b) wX wX0)) #

(Show2 a, Show2 b) => Show ((a :> b) wX wY) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showsPrec :: Int -> (a :> b) wX wY -> ShowS #

show :: (a :> b) wX wY -> String #

showList :: [(a :> b) wX wY] -> ShowS #

(Eq2 a, Eq2 b) => Eq ((a :> b) wX wY) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

(==) :: (a :> b) wX wY -> (a :> b) wX wY -> Bool #

(/=) :: (a :> b) wX wY -> (a :> b) wX wY -> Bool #

type PatchId (p :> p) # 
Instance details

Defined in Darcs.Patch.Ident

type PatchId (p :> p) = Set (PatchId p)

data FL (a :: Type -> Type -> Type) wX wZ where #

Forward lists

Constructors

(:>:) :: forall (a :: Type -> Type -> Type) wX wY wZ. a wX wY -> FL a wY wZ -> FL a wX wZ infixr 5 
NilFL :: forall (a :: Type -> Type -> Type) wX. FL a wX wX 

Instances

Instances details
Apply p => Apply (FL p) # 
Instance details

Defined in Darcs.Patch.Apply

Associated Types

type ApplyState (FL p) 
Instance details

Defined in Darcs.Patch.Apply

type ApplyState (FL p) = ApplyState p

Methods

apply :: ApplyMonad (ApplyState (FL p)) m => FL p wX wY -> m () #

unapply :: ApplyMonad (ApplyState (FL p)) m => FL p wX wY -> m () #

Commute p => Commute (FL p) # 
Instance details

Defined in Darcs.Patch.Commute

Methods

commute :: (FL p :> FL p) wX wY -> Maybe ((FL p :> FL p) wX wY) #

PatchDebug p => PatchDebug (FL p) # 
Instance details

Defined in Darcs.Patch.Debug

Methods

patchDebugDummy :: FL p wX wY -> () #

Effect p => Effect (FL p) # 
Instance details

Defined in Darcs.Patch.Effect

Methods

effect :: FL p wX wY -> FL (PrimOf (FL p)) wX wY #

PrimPatchBase p => PrimPatchBase (FL p) # 
Instance details

Defined in Darcs.Patch.FromPrim

Associated Types

type PrimOf (FL p) 
Instance details

Defined in Darcs.Patch.FromPrim

type PrimOf (FL p) = PrimOf p
Ident p => Ident (FL p) # 
Instance details

Defined in Darcs.Patch.Ident

Methods

ident :: FL p wX wY -> PatchId (FL p) #

PatchInspect p => PatchInspect (FL p) # 
Instance details

Defined in Darcs.Patch.Inspect

Methods

listTouchedFiles :: FL p wX wY -> [AnchoredPath] #

hunkMatches :: (ByteString -> Bool) -> FL p wX wY -> Bool #

Invert p => Invert (FL p) # 
Instance details

Defined in Darcs.Patch.Invert

Methods

invert :: FL p wX wY -> FL p wY wX #

CleanMerge p => CleanMerge (FL p) # 
Instance details

Defined in Darcs.Patch.Merge

Methods

cleanMerge :: (FL p :\/: FL p) wX wY -> Maybe ((FL p :/\: FL p) wX wY) #

Merge p => Merge (FL p) # 
Instance details

Defined in Darcs.Patch.Merge

Methods

merge :: (FL p :\/: FL p) wX wY -> (FL p :/\: FL p) wX wY #

(ReadPatch p, PatchListFormat p) => ReadPatch (FL p) # 
Instance details

Defined in Darcs.Patch.Read

Methods

readPatch' :: Parser (Sealed (FL p wX)) #

Check p => Check (FL p) # 
Instance details

Defined in Darcs.Patch.Repair

Methods

isInconsistent :: FL p wX wY -> Maybe Doc #

RepairToFL p => Repair (FL p) # 
Instance details

Defined in Darcs.Patch.Repair

Methods

applyAndTryToFix :: ApplyMonad (ApplyState (FL p)) m => FL p wX wY -> m (Maybe (String, FL p wX wY)) #

(Apply p, IsHunk p, PatchListFormat p, ShowContextPatch p, ObjectId (ObjectIdOfPatch p)) => ShowContextPatch (FL p) # 
Instance details

Defined in Darcs.Patch.Viewing

(PatchListFormat p, ShowPatch p) => ShowPatch (FL p) # 
Instance details

Defined in Darcs.Patch.Viewing

Methods

content :: FL p wX wY -> Doc #

description :: FL p wX wY -> Doc #

summary :: FL p wX wY -> Doc #

summaryFL :: FL (FL p) wX wY -> Doc #

thing :: FL p wX wY -> String #

things :: FL p wX wY -> String #

(PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL p) # 
Instance details

Defined in Darcs.Patch.Viewing

Methods

showPatch :: ShowPatchFor -> FL p wX wY -> Doc #

Summary p => Summary (FL p) # 
Instance details

Defined in Darcs.Patch.Summary

Methods

conflictedEffect :: FL p wX wY -> [IsConflictedPrim (PrimOf (FL p))] #

Eq2 p => Eq2 (FL p) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

unsafeCompare :: FL p wA wB -> FL p wC wD -> Bool #

(=\/=) :: FL p wA wB -> FL p wA wC -> EqCheck wB wC #

(=/\=) :: FL p wA wC -> FL p wB wC -> EqCheck wA wB #

Show2 a => Show2 (FL a) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict2 :: ShowDict (FL a wX wY) #

Show2 a => Show1 (FL a wX) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict1 :: Dict (Show (FL a wX wX0)) #

Show2 a => Show (FL a wX wZ) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showsPrec :: Int -> FL a wX wZ -> ShowS #

show :: FL a wX wZ -> String #

showList :: [FL a wX wZ] -> ShowS #

type ApplyState (FL p) # 
Instance details

Defined in Darcs.Patch.Apply

type ApplyState (FL p) = ApplyState p
type PrimOf (FL p) # 
Instance details

Defined in Darcs.Patch.FromPrim

type PrimOf (FL p) = PrimOf p
type PatchId (FL p) # 
Instance details

Defined in Darcs.Patch.Ident

type PatchId (FL p) = Set (PatchId p)

data RL (a :: Type -> Type -> Type) wX wZ where #

Reverse lists

Constructors

(:<:) :: forall (a :: Type -> Type -> Type) wX wY wZ. RL a wX wY -> a wY wZ -> RL a wX wZ infixl 5 
NilRL :: forall (a :: Type -> Type -> Type) wX. RL a wX wX 

Instances

Instances details
Apply p => Apply (RL p) # 
Instance details

Defined in Darcs.Patch.Apply

Associated Types

type ApplyState (RL p) 
Instance details

Defined in Darcs.Patch.Apply

type ApplyState (RL p) = ApplyState p

Methods

apply :: ApplyMonad (ApplyState (RL p)) m => RL p wX wY -> m () #

unapply :: ApplyMonad (ApplyState (RL p)) m => RL p wX wY -> m () #

Commute p => Commute (RL p) # 
Instance details

Defined in Darcs.Patch.Commute

Methods

commute :: (RL p :> RL p) wX wY -> Maybe ((RL p :> RL p) wX wY) #

PatchDebug p => PatchDebug (RL p) # 
Instance details

Defined in Darcs.Patch.Debug

Methods

patchDebugDummy :: RL p wX wY -> () #

Effect p => Effect (RL p) # 
Instance details

Defined in Darcs.Patch.Effect

Methods

effect :: RL p wX wY -> FL (PrimOf (RL p)) wX wY #

PrimPatchBase p => PrimPatchBase (RL p) # 
Instance details

Defined in Darcs.Patch.FromPrim

Associated Types

type PrimOf (RL p) 
Instance details

Defined in Darcs.Patch.FromPrim

type PrimOf (RL p) = PrimOf p
Ident p => Ident (RL p) # 
Instance details

Defined in Darcs.Patch.Ident

Methods

ident :: RL p wX wY -> PatchId (RL p) #

PatchInspect p => PatchInspect (RL p) # 
Instance details

Defined in Darcs.Patch.Inspect

Methods

listTouchedFiles :: RL p wX wY -> [AnchoredPath] #

hunkMatches :: (ByteString -> Bool) -> RL p wX wY -> Bool #

Invert p => Invert (RL p) # 
Instance details

Defined in Darcs.Patch.Invert

Methods

invert :: RL p wX wY -> RL p wY wX #

(ReadPatch p, PatchListFormat p) => ReadPatch (RL p) # 
Instance details

Defined in Darcs.Patch.Read

Methods

readPatch' :: Parser (Sealed (RL p wX)) #

Check p => Check (RL p) # 
Instance details

Defined in Darcs.Patch.Repair

Methods

isInconsistent :: RL p wX wY -> Maybe Doc #

(ShowContextPatch p, Apply p, IsHunk p, PatchListFormat p, ObjectId (ObjectIdOfPatch p)) => ShowContextPatch (RL p) # 
Instance details

Defined in Darcs.Patch.Viewing

(PatchListFormat p, ShowPatch p) => ShowPatch (RL p) # 
Instance details

Defined in Darcs.Patch.Viewing

Methods

content :: RL p wX wY -> Doc #

description :: RL p wX wY -> Doc #

summary :: RL p wX wY -> Doc #

summaryFL :: FL (RL p) wX wY -> Doc #

thing :: RL p wX wY -> String #

things :: RL p wX wY -> String #

(PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (RL p) # 
Instance details

Defined in Darcs.Patch.Viewing

Methods

showPatch :: ShowPatchFor -> RL p wX wY -> Doc #

Eq2 p => Eq2 (RL p) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

unsafeCompare :: RL p wA wB -> RL p wC wD -> Bool #

(=\/=) :: RL p wA wB -> RL p wA wC -> EqCheck wB wC #

(=/\=) :: RL p wA wC -> RL p wB wC -> EqCheck wA wB #

Show2 a => Show2 (RL a) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict2 :: ShowDict (RL a wX wY) #

Show2 a => Show1 (RL a wX) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict1 :: Dict (Show (RL a wX wX0)) #

Show2 a => Show (RL a wX wZ) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showsPrec :: Int -> RL a wX wZ -> ShowS #

show :: RL a wX wZ -> String #

showList :: [RL a wX wZ] -> ShowS #

type ApplyState (RL p) # 
Instance details

Defined in Darcs.Patch.Apply

type ApplyState (RL p) = ApplyState p
type PrimOf (RL p) # 
Instance details

Defined in Darcs.Patch.FromPrim

type PrimOf (RL p) = PrimOf p
type PatchId (RL p) # 
Instance details

Defined in Darcs.Patch.Ident

type PatchId (RL p) = Set (PatchId p)

Merge Types

When we have two patches which commute and share the same pre-context we can merge the patches. Whenever patches, or sequences of patches, share a pre-context we say they are Forking Pairs (:\/:). The same way, when patches or sequences of patches, share a post-context we say they are Joining Pairs (:/\:).

The following diagram shows the symmetry of merge types:

          wZ
         :/\:
     a3 /    \ a4  
       /      \    
      wX      wY       
       \      /    
     a1 \    / a2  
         :\/:      
          wZ

data ((a1 :: Type -> Type -> Type) :\/: (a2 :: Type -> Type -> Type)) wX wY infix 1 #

Forking Pairs (Implicit starting context)

Constructors

(a1 wZ wX) :\/: (a2 wZ wY) infix 1 

Instances

Instances details
(Show2 a, Show2 b) => Show2 (a :\/: b) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict2 :: ShowDict ((a :\/: b) wX wY) #

(Show2 a, Show2 b) => Show ((a :\/: b) wX wY) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showsPrec :: Int -> (a :\/: b) wX wY -> ShowS #

show :: (a :\/: b) wX wY -> String #

showList :: [(a :\/: b) wX wY] -> ShowS #

data ((a3 :: Type -> Type -> Type) :/\: (a4 :: Type -> Type -> Type)) wX wY infix 1 #

Joining Pairs

Constructors

(a3 wX wZ) :/\: (a4 wY wZ) infix 1 

Instances

Instances details
(Show2 a, Show2 b) => Show2 (a :/\: b) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showDict2 :: ShowDict ((a :/\: b) wX wY) #

(Show2 a, Show2 b) => Show ((a :/\: b) wX wY) # 
Instance details

Defined in Darcs.Patch.Witnesses.Ordered

Methods

showsPrec :: Int -> (a :/\: b) wX wY -> ShowS #

show :: (a :/\: b) wX wY -> String #

showList :: [(a :/\: b) wX wY] -> ShowS #

data ((a1 :: Type -> Type -> Type) :||: (a2 :: Type -> Type -> Type)) wX wY infix 1 #

Parallel Pairs

Constructors

(a1 wX wY) :||: (a2 wX wY) infix 1 

data Fork (common :: Type -> Type -> Type) (left :: Type -> Type -> Type) (right :: Type -> Type -> Type) wA wX wY #

Forking Pair (Explicit starting context)

      wX     wY       
       \     /    
        \   /
         \ /     
          wU
          |
          |
          |
          wA

Constructors

Fork (common wA wU) (left wU wX) (right wU wY) 

Functions for FLs and RLs

nullFL :: forall (a :: Type -> Type -> Type) wX wZ. FL a wX wZ -> Bool #

nullRL :: forall (a :: Type -> Type -> Type) wX wZ. RL a wX wZ -> Bool #

lengthFL :: forall (a :: Type -> Type -> Type) wX wZ. FL a wX wZ -> Int #

lengthRL :: forall (a :: Type -> Type -> Type) wX wZ. RL a wX wZ -> Int #

mapFL :: (forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b] #

mapRL :: (forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b] #

mapFL_FL :: (forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ #

mapRL_RL :: (forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ #

foldrFL :: (forall wA wB. p wA wB -> r -> r) -> FL p wX wY -> r -> r #

The "natural" fold over an FL i.e. associating to the right. Like foldr only with the more useful order of arguments.

foldlRL :: (forall wA wB. r -> p wA wB -> r) -> r -> RL p wX wY -> r #

The "natural" fold over an RL i.e. associating to the left.

foldrwFL :: (forall wA wB. p wA wB -> r wB -> r wA) -> FL p wX wY -> r wY -> r wX #

Right associative fold for FLs that transforms a witnessed state in the direction opposite to the FL. This is the "natural" fold for FLs i.e. the one which replaces the :>: with the passed operator.

foldlwRL :: (forall wA wB. p wA wB -> r wA -> r wB) -> RL p wX wY -> r wX -> r wY #

The analog of foldrwFL for RLs. This is the "natural" fold for RLs i.e. the one which replaces the :<: with the (flipped) passed operator.

foldlwFL :: (forall wA wB. p wA wB -> r wA -> r wB) -> FL p wX wY -> r wX -> r wY #

Strict left associative fold for FLs that transforms a witnessed state in the direction of the patches. This is for apply-like functions that transform the witnesses in forward direction.

foldrwRL :: (forall wA wB. p wA wB -> r wB -> r wA) -> RL p wX wY -> r wY -> r wX #

Strict right associative fold for RLs that transforms a witnessed state in the opposite direction of the patches. This is for unapply-like functions that transform the witnesses in backward direction.

allFL :: (forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool #

allRL :: (forall wA wB. a wA wB -> Bool) -> RL a wX wY -> Bool #

anyFL :: (forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool #

anyRL :: (forall wA wB. a wA wB -> Bool) -> RL a wX wY -> Bool #

filterFL :: (forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> [Sealed2 a] #

filterRL :: (forall wX wY. p wX wY -> Bool) -> RL p wA wB -> [Sealed2 p] #

foldFL_M :: Monad m => (forall wA wB. r wA -> p wA wB -> m (r wB)) -> r wX -> FL p wX wY -> m (r wY) #

Monadic fold over an FL associating to the left, sequencing effects from left to right. The order of arguments follows the standard foldM from base.

foldRL_M :: Monad m => (forall wA wB. p wA wB -> r wB -> m (r wA)) -> RL p wX wY -> r wY -> m (r wX) #

Monadic fold over an FL associating to the right, sequencing effects from right to left. Mostly useful for prepend-like operations with an effect where the order of effects is not relevant.

splitAtFL :: forall (a :: Type -> Type -> Type) wX wZ. Int -> FL a wX wZ -> (FL a :> FL a) wX wZ #

splitAtRL :: forall (a :: Type -> Type -> Type) wX wZ. Int -> RL a wX wZ -> (RL a :> RL a) wX wZ #

filterOutFLFL :: (forall wX wY. p wX wY -> EqCheck wX wY) -> FL p wW wZ -> FL p wW wZ #

filterOutFLFL p xs deletes any x in xs for which p x == IsEq (indicating that x has no effect as far as we are concerned, and can be safely removed from the chain)

filterOutRLRL :: (forall wX wY. p wX wY -> EqCheck wX wY) -> RL p wW wZ -> RL p wW wZ #

reverseFL :: forall (a :: Type -> Type -> Type) wX wZ. FL a wX wZ -> RL a wX wZ #

reverseRL :: forall (a :: Type -> Type -> Type) wX wZ. RL a wX wZ -> FL a wX wZ #

(+>+) :: forall (a :: Type -> Type -> Type) wX wY wZ. FL a wX wY -> FL a wY wZ -> FL a wX wZ infixr 5 #

Concatenate two FLs. This traverses only the left hand side.

(+<+) :: forall (a :: Type -> Type -> Type) wX wY wZ. RL a wX wY -> RL a wY wZ -> RL a wX wZ infixl 5 #

Concatenate two RLs. This traverses only the right hand side.

(+>>+) :: forall (p :: Type -> Type -> Type) wX wY wZ. RL p wX wY -> FL p wY wZ -> FL p wX wZ infixr 5 #

Prepend an RL to an FL. This traverses only the left hand side.

(+<<+) :: forall (p :: Type -> Type -> Type) wX wY wZ. RL p wX wY -> FL p wY wZ -> RL p wX wZ infixl 5 #

Append an FL to an RL. This traverses only the right hand side.

concatFL :: forall (a :: Type -> Type -> Type) wX wZ. FL (FL a) wX wZ -> FL a wX wZ #

concatRL :: forall (a :: Type -> Type -> Type) wX wZ. RL (RL a) wX wZ -> RL a wX wZ #

dropWhileFL :: (forall wX wY. a wX wY -> Bool) -> FL a wR wV -> FlippedSeal (FL a) wV #

dropWhileRL :: (forall wX wY. a wX wY -> Bool) -> RL a wR wV -> Sealed (RL a wR) #

FL only

bunchFL :: forall (a :: Type -> Type -> Type) wX wY. Int -> FL a wX wY -> FL (FL a) wX wY #

spanFL :: (forall wW wY. a wW wY -> Bool) -> FL a wX wZ -> (FL a :> FL a) wX wZ #

spanFL_M :: forall a m wX wZ. Monad m => (forall wW wY. a wW wY -> m Bool) -> FL a wX wZ -> m ((FL a :> FL a) wX wZ) #

zipWithFL :: (forall wX wY. a -> p wX wY -> q wX wY) -> [a] -> FL p wW wZ -> FL q wW wZ #

consGapFL :: Gap w => (forall wX wY. p wX wY) -> w (FL p) -> w (FL p) #

concatGapsFL :: forall w (p :: Type -> Type -> Type). Gap w => [w (FL p)] -> w (FL p) #

joinGapsFL :: forall w (p :: Type -> Type -> Type). Gap w => [w p] -> w (FL p) #

mapFL_FL_M :: Monad m => (forall wW wY. a wW wY -> m (b wW wY)) -> FL a wX wZ -> m (FL b wX wZ) #

sequenceFL_ :: Monad m => (forall wW wZ. a wW wZ -> m b) -> FL a wX wY -> m () #

initsFL :: forall (p :: Type -> Type -> Type) wX wY. FL p wX wY -> [Sealed ((p :> FL p) wX)] #

RL only

isShorterThanRL :: forall (a :: Type -> Type -> Type) wX wY. RL a wX wY -> Int -> Bool #

spanRL :: (forall wA wB. p wA wB -> Bool) -> RL p wX wY -> (RL p :> RL p) wX wY #

Like span only for RLs. This function is supposed to be lazy: elements before the split point should not be touched.

breakRL :: (forall wA wB. p wA wB -> Bool) -> RL p wX wY -> (RL p :> RL p) wX wY #

Like break only for RLs. This function is supposed to be lazy: elements before the split point should not be touched.

takeWhileRL :: (forall wA wB. a wA wB -> Bool) -> RL a wX wY -> FlippedSeal (RL a) wY #

Like takeWhile only for RLs. This function is supposed to be lazy: elements before the split point should not be touched.

concatRLFL :: forall (p :: Type -> Type -> Type) wX wY. RL (FL p) wX wY -> RL p wX wY #