d0fe997 · patch · git.iko.soy

git.iko.soy/patch

Add Indexed* classes and newtype wrappers for other patch classes

commitd0fe997bf2e61a9dde4673f544c9157bb516fb9e authorJohn Ericson <John.Ericson@Obsidian.Systems> dateFri 17 Jan 2020, 14:32 (7 years ago) parentf03b9c1

3 files changed+53−23

compare with develop

unifiedsplit

src/Data/Patch/IntMap.hs+5−3 src/Data/Patch/Map.hs+28−13 src/Data/Patch/MapWithMove.hs+20−7

src/Data/Patch/IntMap.hs+5−3

@@ -1,11 +1,10 @@

1−{-# LANGUAGE DeriveFoldable #-}

2−{-# LANGUAGE DeriveFunctor #-}

31{-# LANGUAGE DeriveTraversable #-}

42{-# LANGUAGE FlexibleInstances #-}

53{-# LANGUAGE GeneralizedNewtypeDeriving #-}

64{-# LANGUAGE MultiParamTypeClasses #-}

75{-# LANGUAGE TemplateHaskell #-}

86{-# LANGUAGE TypeFamilies #-}

98-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for

109-- insert/update or delete of associations.

1110module Data.Patch.IntMap where

@@ -20,7 +19,10 @@ import Data.Patch.Class

2019-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.

2120-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update

2221-- and @Nothing@ means delete.

23−newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

22+newtype PatchIntMap a = PatchIntMap { unPatchIntMap :: IntMap (Maybe a) }

23+ deriving ( Show, Read, Eq, Ord

24+ , Functor, Foldable, Traversable, Monoid

25+ )

2426

2527-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

2628-- If the same key is modified by both patches, the one on the left will take

src/Data/Patch/Map.hs+28−13

@@ -1,11 +1,18 @@

1+{-# LANGUAGE DeriveTraversable #-}

2+{-# LANGUAGE FlexibleInstances #-}

13{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

5+{-# LANGUAGE StandaloneDeriving #-}

6+{-# LANGUAGE TemplateHaskell #-}

27{-# LANGUAGE TypeFamilies #-}

39-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)

410-- and deletions

511module Data.Patch.Map where

612

713import Data.Patch.Class

814

15+import Control.Lens

916import Data.Map (Map)

1017import qualified Data.Map as Map

1118import Data.Maybe

@@ -15,7 +22,23 @@ import Data.Semigroup

1522-- deleted. Insertions are represented as values wrapped in 'Just', while

1623-- deletions are represented as 'Nothing's

1724newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

18− deriving (Show, Read, Eq, Ord)

25+ deriving ( Show, Read, Eq, Ord

26+ , Foldable, Traversable

27+ )

28+

29+-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.

30+-- Deletions are unaffected.

31+deriving instance Functor (PatchMap k)

32+

33+-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

34+-- If the same key is modified by both patches, the one on the left will take

35+-- precedence.

36+instance Ord k => Semigroup (PatchMap k v) where

37+ PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

38+ -- PatchMap is idempotent, so stimes n is id for every n

39+ stimes = stimesIdempotentMonoid

40+

41+makeWrapped ''PatchMap

1942

2043-- | Apply the insertions or deletions to a given 'Map'.

2144instance Ord k => Patch (PatchMap k v) where

@@ -28,24 +51,16 @@ instance Ord k => Patch (PatchMap k v) where

2851 Nothing -> Just ()

2952 Just _ -> Nothing

3053

31−-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

32−-- If the same key is modified by both patches, the one on the left will take

33−-- precedence.

34−instance Ord k => Semigroup (PatchMap k v) where

35− PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

36− -- PatchMap is idempotent, so stimes n is id for every n

37− stimes = stimesIdempotentMonoid

54+instance FunctorWithIndex k (PatchMap k)

55+instance FoldableWithIndex k (PatchMap k)

56+instance TraversableWithIndex k (PatchMap k) where

57+ itraverse f (PatchMap x) = PatchMap <$> itraverse (traverse . f) x

3858

3959-- | The empty 'PatchMap' contains no insertions or deletions

4060instance Ord k => Monoid (PatchMap k v) where

4161 mempty = PatchMap mempty

4262 mappend = (<>)

4363

44−-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.

45−-- Deletions are unaffected.

46−instance Functor (PatchMap k) where

47− fmap f = PatchMap . fmap (fmap f) . unPatchMap

48−

4964-- | Returns all the new elements that will be added to the 'Map'

5065patchMapNewElements :: PatchMap k v -> [v]

5166patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p

src/Data/Patch/MapWithMove.hs+20−7

@@ -1,11 +1,14 @@

1−{-# LANGUAGE DeriveFoldable #-}

2−{-# LANGUAGE DeriveFunctor #-}

31{-# LANGUAGE DeriveTraversable #-}

42{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE FlexibleInstances #-}

54{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

66{-# LANGUAGE PatternGuards #-}

77{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TemplateHaskell #-}

9+{-# LANGUAGE TypeApplications #-}

810{-# LANGUAGE TypeFamilies #-}

11+

912-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to

1013-- another

1114module Data.Patch.MapWithMove where

@@ -13,6 +16,7 @@ module Data.Patch.MapWithMove where

1316import Data.Patch.Class

1417

1518import Control.Arrow

19+import Control.Lens hiding (from, to)

1620import Control.Monad.Trans.State

1721import Data.Foldable

1822import Data.Function

@@ -28,7 +32,13 @@ import Data.Tuple

2832-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@

2933-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,

3034-- and vice versa. There should never be any unpaired From/To keys.

31−newtype PatchMapWithMove k v = PatchMapWithMove (Map k (NodeInfo k v)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

35+newtype PatchMapWithMove k v = PatchMapWithMove

36+ { -- | Extract the internal representation of the 'PatchMapWithMove'

37+ unPatchMapWithMove :: Map k (NodeInfo k v)

38+ }

39+ deriving ( Show, Read, Eq, Ord

40+ , Functor, Foldable, Traversable

41+ )

3242

3343-- | Holds the information about each key: where its new value should come from,

3444-- and where its old value should go to

@@ -53,6 +63,13 @@ data From k v

5363-- that means it will be deleted.

5464type To = Maybe

5565

66+makeWrapped ''PatchMapWithMove

67+

68+instance FunctorWithIndex k (PatchMapWithMove k)

69+instance FoldableWithIndex k (PatchMapWithMove k)

70+instance TraversableWithIndex k (PatchMapWithMove k) where

71+ itraverse f (PatchMapWithMove x) = PatchMapWithMove <$> itraverse (traverse . f) x

72+

5673-- | Create a 'PatchMapWithMove', validating it

5774patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

5875patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

@@ -70,10 +87,6 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo

7087 , _nodeInfo_to = Nothing

7188 }

7289

73−-- | Extract the internal representation of the 'PatchMapWithMove'

74−unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

75−unPatchMapWithMove (PatchMapWithMove p) = p

76−

7790-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.

7891insertMapKey :: k -> v -> PatchMapWithMove k v

7992insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing