git.iko.soy/patch
on develop help sign in
Add Indexed* classes and newtype wrappers for other patch classes
d0fe997John Ericson
src/Data/Patch/IntMap.hs+5−3
compare with develop
unifiedsplit
@@ -1,11 +1,10 @@
1−{-# LANGUAGE DeriveFoldable #-}
2−{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveTraversable #-}
1{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7+
9-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
8-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
10-- insert/update or delete of associations.
9-- insert/update or delete of associations.
11module Data.Patch.IntMap where
10module Data.Patch.IntMap where
@@ -20,7 +19,10 @@ import Data.Patch.Class
20-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.
19-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.
21-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update
20-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update
22-- and @Nothing@ means delete.
21-- 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+ )
24
26
25-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
27-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
26-- If the same key is modified by both patches, the one on the left will take
28-- 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 #-}
1{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE StandaloneDeriving #-}
6+{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8+
3-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
9-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
4-- and deletions
10-- and deletions
5module Data.Patch.Map where
11module Data.Patch.Map where
6
12
7import Data.Patch.Class
13import Data.Patch.Class
8
14
15+import Control.Lens
9import Data.Map (Map)
16import Data.Map (Map)
10import qualified Data.Map as Map
17import qualified Data.Map as Map
11import Data.Maybe
18import Data.Maybe
@@ -15,7 +22,23 @@ import Data.Semigroup
15-- deleted. Insertions are represented as values wrapped in 'Just', while
22-- deleted. Insertions are represented as values wrapped in 'Just', while
16-- deletions are represented as 'Nothing's
23-- deletions are represented as 'Nothing's
17newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
24newtype 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
19
42
20-- | Apply the insertions or deletions to a given 'Map'.
43-- | Apply the insertions or deletions to a given 'Map'.
21instance Ord k => Patch (PatchMap k v) where
44instance Ord k => Patch (PatchMap k v) where
@@ -28,24 +51,16 @@ instance Ord k => Patch (PatchMap k v) where
28 Nothing -> Just ()
51 Nothing -> Just ()
29 Just _ -> Nothing
52 Just _ -> Nothing
30
53
31−-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
54+instance FunctorWithIndex k (PatchMap k)
32−-- If the same key is modified by both patches, the one on the left will take
55+instance FoldableWithIndex k (PatchMap k)
33−-- precedence.
34−instance Ord k => Semigroup (PatchMap k v) where
56+instance TraversableWithIndex k (PatchMap k) where
35− PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
57+ itraverse f (PatchMap x) = PatchMap <$> itraverse (traverse . f) x
36− -- PatchMap is idempotent, so stimes n is id for every n
37− stimes = stimesIdempotentMonoid
38
58
39-- | The empty 'PatchMap' contains no insertions or deletions
59-- | The empty 'PatchMap' contains no insertions or deletions
40instance Ord k => Monoid (PatchMap k v) where
60instance Ord k => Monoid (PatchMap k v) where
41 mempty = PatchMap mempty
61 mempty = PatchMap mempty
42 mappend = (<>)
62 mappend = (<>)
43
63
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−
49-- | Returns all the new elements that will be added to the 'Map'
64-- | Returns all the new elements that will be added to the 'Map'
50patchMapNewElements :: PatchMap k v -> [v]
65patchMapNewElements :: PatchMap k v -> [v]
51patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
66patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
src/Data/Patch/MapWithMove.hs+20−7
@@ -1,11 +1,14 @@
1−{-# LANGUAGE DeriveFoldable #-}
2−{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveTraversable #-}
1{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE PatternGuards #-}
6{-# LANGUAGE PatternGuards #-}
7{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TemplateHaskell #-}
9+{-# LANGUAGE TypeApplications #-}
8{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
11+
9-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
12-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
10-- another
13-- another
11module Data.Patch.MapWithMove where
14module Data.Patch.MapWithMove where
@@ -13,6 +16,7 @@ module Data.Patch.MapWithMove where
13import Data.Patch.Class
16import Data.Patch.Class
14
17
15import Control.Arrow
18import Control.Arrow
19+import Control.Lens hiding (from, to)
16import Control.Monad.Trans.State
20import Control.Monad.Trans.State
17import Data.Foldable
21import Data.Foldable
18import Data.Function
22import Data.Function
@@ -28,7 +32,13 @@ import Data.Tuple
28-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
32-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
29-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
33-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
30-- and vice versa. There should never be any unpaired From/To keys.
34-- 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+ )
32
42
33-- | Holds the information about each key: where its new value should come from,
43-- | Holds the information about each key: where its new value should come from,
34-- and where its old value should go to
44-- and where its old value should go to
@@ -53,6 +63,13 @@ data From k v
53-- that means it will be deleted.
63-- that means it will be deleted.
54type To = Maybe
64type To = Maybe
55
65
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+
56-- | Create a 'PatchMapWithMove', validating it
73-- | Create a 'PatchMapWithMove', validating it
57patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
74patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
58patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
75patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
@@ -70,10 +87,6 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo
70 , _nodeInfo_to = Nothing
87 , _nodeInfo_to = Nothing
71 }
88 }
72
89
73−-- | Extract the internal representation of the 'PatchMapWithMove'
74−unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
75−unPatchMapWithMove (PatchMapWithMove p) = p
76−
77-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
90-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
78insertMapKey :: k -> v -> PatchMapWithMove k v
91insertMapKey :: k -> v -> PatchMapWithMove k v
79insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing
92insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing