git.iko.soy/patch
on develop help sign in
Add to `PatchMapWithPatchingMove`'s interface
2565222John Ericson
src/Data/Patch/MapWithPatchingMove.hs+26−1
compare with develop
unifiedsplit
@@ -6,6 +6,7 @@
6{-# LANGUAGE PatternGuards #-}
6{-# LANGUAGE PatternGuards #-}
7{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE StandaloneDeriving #-}
8{-# LANGUAGE StandaloneDeriving #-}
9+{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE UndecidableInstances #-}
11{-# LANGUAGE UndecidableInstances #-}
11
12
@@ -16,6 +17,7 @@ module Data.Patch.MapWithPatchingMove where
16import Data.Patch.Class
17import Data.Patch.Class
17
18
18import Control.Arrow
19import Control.Arrow
20+import Control.Lens.TH (makeWrapped)
19import Control.Monad.Trans.State
21import Control.Monad.Trans.State
20import Data.Foldable
22import Data.Foldable
21import Data.Function
23import Data.Function
@@ -23,7 +25,6 @@ import Data.List
23import Data.Map (Map)
25import Data.Map (Map)
24import qualified Data.Map as Map
26import qualified Data.Map as Map
25import Data.Maybe
27import Data.Maybe
26−--import Data.Proxy
27#if !MIN_VERSION_base(4,10,0)
28#if !MIN_VERSION_base(4,10,0)
28import Data.Semigroup (Semigroup (..))
29import Data.Semigroup (Semigroup (..))
29#endif
30#endif
@@ -39,6 +40,7 @@ newtype PatchMapWithPatchingMove k p = PatchMapWithPatchingMove
39 { -- | Extract the internal representation of the 'PatchMapWithPatchingMove'
40 { -- | Extract the internal representation of the 'PatchMapWithPatchingMove'
40 unPatchMapWithPatchingMove :: Map k (NodeInfo k p)
41 unPatchMapWithPatchingMove :: Map k (NodeInfo k p)
41 }
42 }
43+
42deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithPatchingMove k p)
44deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithPatchingMove k p)
43deriving instance (Ord k, Read k, Read p, Read (PatchTarget p)) => Read (PatchMapWithPatchingMove k p)
45deriving instance (Ord k, Read k, Read p, Read (PatchTarget p)) => Read (PatchMapWithPatchingMove k p)
44deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithPatchingMove k p)
46deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithPatchingMove k p)
@@ -58,12 +60,33 @@ deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
58deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
60deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
59deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
61deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
60
62
63+bitraverseNodeInfo
64+ :: Applicative f
65+ => (k0 -> f k1)
66+ -> (p0 -> f p1)
67+ -> (PatchTarget p0 -> f (PatchTarget p1))
68+ -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
69+bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
70+ <$> bitraverseFrom fk fp fpt from
71+ <*> traverse fk to
72+
61-- | Describe how a key's new value should be produced
73-- | Describe how a key's new value should be produced
62data From k p
74data From k p
63 = From_Insert (PatchTarget p) -- ^ Insert the given value here
75 = From_Insert (PatchTarget p) -- ^ Insert the given value here
64 | From_Delete -- ^ Delete the existing value, if any, from here
76 | From_Delete -- ^ Delete the existing value, if any, from here
65 | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
77 | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
66
78
79+bitraverseFrom
80+ :: Applicative f
81+ => (k0 -> f k1)
82+ -> (p0 -> f p1)
83+ -> (PatchTarget p0 -> f (PatchTarget p1))
84+ -> From k0 p0 -> f (From k1 p1)
85+bitraverseFrom fk fp fpt = \case
86+ From_Insert pt -> From_Insert <$> fpt pt
87+ From_Delete -> pure From_Delete
88+ From_Move k p -> From_Move <$> fk k <*> fp p
89+
67deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
90deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
68deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
91deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
69deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
92deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
@@ -326,3 +349,5 @@ instance ( Ord k
326 ) => Monoid (PatchMapWithPatchingMove k p) where
349 ) => Monoid (PatchMapWithPatchingMove k p) where
327 mempty = PatchMapWithPatchingMove mempty
350 mempty = PatchMapWithPatchingMove mempty
328 mappend = (<>)
351 mappend = (<>)
352+
353+makeWrapped ''PatchMapWithPatchingMove