@@ -1,11 +1,14 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE LambdaCase #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
46{-# LANGUAGE PatternGuards #-}
57{-# LANGUAGE ScopedTypeVariables #-}
68{-# LANGUAGE StandaloneDeriving #-}
79{-# LANGUAGE TypeFamilies #-}
810{-# LANGUAGE UndecidableInstances #-}
11+
912-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
1013-- another
1114module Data.Patch.MapWithMove where
@@ -20,6 +23,7 @@ import Data.List
2023import Data.Map (Map)
2124import qualified Data.Map as Map
2225import Data.Maybe
26+--import Data.Proxy
2327#if !MIN_VERSION_base(4,9,0)
2428import Data.Semigroup (Semigroup (..), (<>))
2529#endif
@@ -31,8 +35,12 @@ import Data.Tuple
3135-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
3236-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
3337-- and vice versa. There should never be any unpaired From/To keys.
34−newtype PatchMapWithMove k p = PatchMapWithMove (Map k (NodeInfo k p))
38+newtype PatchMapWithMove k p = PatchMapWithMove
39+ { -- | Extract the internal representation of the 'PatchMapWithMove'
40+ unPatchMapWithMove :: Map k (NodeInfo k p)
41+ }
3542deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithMove k p)
43+deriving instance (Ord k, Read k, Read p, Read (PatchTarget p)) => Read (PatchMapWithMove k p)
3644deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithMove k p)
3745deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (PatchMapWithMove k p)
3846
@@ -85,12 +93,7 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo
8593 , _nodeInfo_to = Nothing
8694 }
8795
88−-- | Extract the internal representation of the 'PatchMapWithMove'
89−unPatchMapWithMove
90− :: PatchMapWithMove k p -> Map k (NodeInfo k p)
91−unPatchMapWithMove (PatchMapWithMove p) = p
92−
93−-- | Make a @'PatchMapWithMove' k p@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
96+-- | Make a @'PatchMapWithMove' k p@ which has the effect of inserting or replacing a value @v@ at the given key @k@, like 'Map.insert'.
9497insertMapKey
9598 :: k -> PatchTarget p -> PatchMapWithMove k p
9699insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing
@@ -120,7 +123,8 @@ moveMapKey src dst
120123-- . Map.delete a . Map.delete b $ map
121124-- @
122125swapMapKey
123− :: (DecidablyEmpty p, Patch p) => Ord k => k -> k -> PatchMapWithMove k p
126+ :: (DecidablyEmpty p, Patch p)
127+ => Ord k => k -> k -> PatchMapWithMove k p
124128swapMapKey src dst
125129 | src == dst = mempty
126130 | otherwise =
@@ -129,7 +133,8 @@ swapMapKey src dst
129133 , (src, NodeInfo (From_Move dst mempty) (Just dst))
130134 ]
131135
132−-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
136+-- | Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in
137+-- the mapping, equivalent to 'Map.delete'.
133138deleteMapKey
134139 :: k -> PatchMapWithMove k v
135140deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing
@@ -144,7 +149,11 @@ unsafePatchMapWithMove = PatchMapWithMove
144149-- | Apply the insertions, deletions, and moves to a given 'Map'
145150instance (Ord k, Patch p) => Patch (PatchMapWithMove k p) where
146151 type PatchTarget (PatchMapWithMove k p) = Map k (PatchTarget p)
147− apply (PatchMapWithMove m) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
152+ -- TODO: return Nothing sometimes
153+ -- Note: the strict application here is critical to ensuring that incremental
154+ -- merges don't hold onto all their prerequisite events forever; can we make
155+ -- this more robust?
156+ apply (PatchMapWithMove m) old = Just $! insertions `Map.union` (old `Map.difference` deletions)
148157 where insertions = flip Map.mapMaybeWithKey m $ \_ ni -> case _nodeInfo_from ni of
149158 From_Insert v -> Just v
150159 From_Move k p -> applyAlways p <$> Map.lookup k old
@@ -308,7 +317,8 @@ instance ( Ord k
308317 That b -> Just b
309318
310319--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
311−-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
320+-- | Compose patches having the same effect as applying the patches in turn:
321+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
312322instance ( Ord k
313323 , Monoid p
314324 , DecidablyEmpty p