patch-0.0.2.0: Infrastructure for writing patches which act on other types.

Safe HaskellNone
LanguageHaskell98

Data.Patch.DMapWithMove

Description

Module containing PatchDMapWithMove k v and associated functions, which represents a Patch to a DMap k v which can insert, update, delete, and move values between keys.

Synopsis

Documentation

newtype PatchDMapWithMove k v Source #

Like PatchMapWithMove, but for DMap. Each key carries a NodeInfo which describes how it will be changed by the patch and connects move sources and destinations.

Invariants:

  • A key should not move to itself.
  • A move should always be represented with both the destination key (as a From_Move) and the source key (as a ComposeMaybe (Just destination))

Constructors

PatchDMapWithMove (DMap k (NodeInfo k v)) 
Instances
(GEq k2, Has' Eq k2 (NodeInfo k2 v)) => Eq (PatchDMapWithMove k2 v) Source #

Test whether two PatchDMapWithMove k v contain the same patch operations.

Instance details

Defined in Data.Patch.DMapWithMove

GCompare k2 => Semigroup (PatchDMapWithMove k2 v) Source #

Compose patches having the same effect as applying the patches in turn: applyAlways (p <> q) == applyAlways p . applyAlways q

Instance details

Defined in Data.Patch.DMapWithMove

GCompare k2 => Monoid (PatchDMapWithMove k2 v) Source #

Compose patches having the same effect as applying the patches in turn: applyAlways (p <> q) == applyAlways p . applyAlways q

Instance details

Defined in Data.Patch.DMapWithMove

GCompare k2 => DecidablyEmpty (PatchDMapWithMove k2 v) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

GCompare k2 => Patch (PatchDMapWithMove k2 v) Source #

Apply the insertions, deletions, and moves to a given DMap.

Instance details

Defined in Data.Patch.DMapWithMove

Associated Types

type PatchTarget (PatchDMapWithMove k2 v) :: Type Source #

type PatchTarget (PatchDMapWithMove k2 v) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

data NodeInfo k v a Source #

Structure which represents what changes apply to a particular key. _nodeInfo_from specifies what happens to this key, and in particular what other key the current key is moving from, while _nodeInfo_to specifies what key the current key is moving to if involved in a move.

Constructors

NodeInfo 

Fields

  • _nodeInfo_from :: !(From k v a)

    Change applying to the current key, be it an insert, move, or delete.

  • _nodeInfo_to :: !(To k a)

    Where this key is moving to, if involved in a move. Should only be ComposeMaybe (Just k) when there is a corresponding From_Move.

Instances
(Show (v a), Show (k2 a)) => Show (NodeInfo k2 v a) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

Methods

showsPrec :: Int -> NodeInfo k2 v a -> ShowS #

show :: NodeInfo k2 v a -> String #

showList :: [NodeInfo k2 v a] -> ShowS #

data From (k :: a -> *) (v :: a -> *) :: a -> * where Source #

Structure describing a particular change to a key, be it inserting a new key (From_Insert), updating an existing key (From_Insert again), deleting a key (From_Delete), or moving a key (From_Move).

Constructors

From_Insert :: v a -> From k v a

Insert a new or update an existing key with the given value v a

From_Delete :: From k v a

Delete the existing key

From_Move :: !(k a) -> From k v a

Move the value from the given key k a to this key. The source key should also have an entry in the patch giving the current key as _nodeInfo_to, usually but not necessarily with From_Delete.

Instances
(Eq (v b), Eq (k b)) => Eq (From k v b) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

Methods

(==) :: From k v b -> From k v b -> Bool #

(/=) :: From k v b -> From k v b -> Bool #

(Ord (v b), Ord (k b)) => Ord (From k v b) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

Methods

compare :: From k v b -> From k v b -> Ordering #

(<) :: From k v b -> From k v b -> Bool #

(<=) :: From k v b -> From k v b -> Bool #

(>) :: From k v b -> From k v b -> Bool #

(>=) :: From k v b -> From k v b -> Bool #

max :: From k v b -> From k v b -> From k v b #

min :: From k v b -> From k v b -> From k v b #

(Read (v b), Read (k b)) => Read (From k v b) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

Methods

readsPrec :: Int -> ReadS (From k v b) #

readList :: ReadS [From k v b] #

readPrec :: ReadPrec (From k v b) #

readListPrec :: ReadPrec [From k v b] #

(Show (v b), Show (k b)) => Show (From k v b) Source # 
Instance details

Defined in Data.Patch.DMapWithMove

Methods

showsPrec :: Int -> From k v b -> ShowS #

show :: From k v b -> String #

showList :: [From k v b] -> ShowS #

type To = ComposeMaybe Source #

Type alias for the "to" part of a NodeInfo. ComposeMaybe (Just k) means the key is moving to another key, ComposeMaybe Nothing for any other operation.

validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool Source #

Test whether a PatchDMapWithMove satisfies its invariants.

validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String] Source #

Enumerate what reasons a PatchDMapWithMove doesn't satisfy its invariants, returning [] if it's valid.

data Pair1 f g a Source #

Higher kinded 2-tuple, identical to Data.Functor.Product from base ≥ 4.9

Constructors

Pair1 (f a) (g a) 

data Fixup k v a Source #

Helper data structure used for composing patches using the monoid instance.

Constructors

Fixup_Delete 
Fixup_Update (These (From k v a) (To k a)) 

insertDMapKey :: k a -> v a -> PatchDMapWithMove k v Source #

Make a PatchDMapWithMove k v which has the effect of inserting or updating a value v a to the given key k a, like insert.

moveDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v Source #

Make a PatchDMapWithMove k v which has the effect of moving the value from the first key k a to the second key k a, equivalent to:

    delete src (maybe dmap (insert dst) (DMap.lookup src dmap))

swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v Source #

Make a PatchDMapWithMove k v which has the effect of swapping two keys in the mapping, equivalent to:

    let aMay = DMap.lookup a dmap
        bMay = DMap.lookup b dmap
    in maybe id (DMap.insert a) (bMay mplus aMay)
     . maybe id (DMap.insert b) (aMay mplus bMay)
     . DMap.delete a . DMap.delete b $ dmap

deleteDMapKey :: k a -> PatchDMapWithMove k v Source #

Make a PatchDMapWithMove k v which has the effect of deleting a key in the mapping, equivalent to delete.

unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (NodeInfo k v) Source #

Extract the DMap representing the patch changes from the PatchDMapWithMove.

unsafePatchDMapWithMove :: DMap k (NodeInfo k v) -> PatchDMapWithMove k v Source #

Wrap a DMap representing patch changes into a PatchDMapWithMove, without checking any invariants.

Warning: when using this function, you must ensure that the invariants of PatchDMapWithMove are preserved; they will not be checked.

patchDMapWithMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v) Source #

Wrap a DMap representing patch changes into a PatchDMapWithMove while checking invariants. If the invariants are satisfied, Right p is returned otherwise Left errors.

mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v' Source #

Map a natural transform v -> v' over the given patch, transforming PatchDMapWithMove k v into PatchDMapWithMove k v'.

traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v') Source #

Traverse an effectful function forall a. v a -> m (v ' a) over the given patch, transforming PatchDMapWithMove k v into m (PatchDMapWithMove k v').

traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v') Source #

Map an effectful function forall a. k a -> v a -> m (v ' a) over the given patch, transforming PatchDMapWithMove k v into m (PatchDMapWithMove k v').

nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a Source #

Map a function which transforms From k v a into a From k v' a over a NodeInfo k v a.

nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a) Source #

Map an effectful function which transforms From k v a into a f (From k v' a) over a NodeInfo k v a.

weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v' Source #

Weaken a PatchDMapWithMove to a PatchMapWithMove by weakening the keys from k a to Some k and applying a given weakening function v a -> v' to values.

patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v' Source #

Weaken a PatchDMapWithMove (Const2 k a) v to a PatchMapWithMove k v'. Weaken is in scare quotes because the Const2 has already disabled any dependency in the typing and all points are already a, hence the function to map each value to v' is not higher rank.

const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v' Source #

Strengthen a PatchMapWithMove k v into a 'PatchDMapWithMove (Const2 k a); that is, turn a non-dependently-typed patch into a dependently typed one but which always has a constant key type represented by Const2. Apply the given function to each v to produce a v' a. Completemented by patchDMapWithMoveToPatchMapWithMoveWith

getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k)) Source #

Get the values that will be replaced, deleted, or moved if the given patch is applied to the given DMap.