cb657ca · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Clean up

cb657caJohn Ericson7 years ago

patch.cabal+1

compare with develop

unifiedsplit

@@ -40,6 +40,7 @@ library

40 , witherable >= 0.3 && < 0.3.2

42 exposed-modules: Data.Functor.Misc

43+ , Data.Monoid.DecidablyEmpty

43 , Data.Patch

44 , Data.Patch

44 , Data.Patch.Class

45 , Data.Patch.Class

45 , Data.Patch.DMap

46 , Data.Patch.DMap

src/Data/Patch/MapWithMove.hs+21−11

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE PatternGuards #-}

6{-# LANGUAGE PatternGuards #-}

5{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE StandaloneDeriving #-}

8{-# LANGUAGE StandaloneDeriving #-}

7{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE UndecidableInstances #-}

10{-# LANGUAGE UndecidableInstances #-}

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

@@ -20,6 +23,7 @@ import Data.List

20import Data.Map (Map)

23import Data.Map (Map)

21import qualified Data.Map as Map

24import qualified Data.Map as Map

22import Data.Maybe

25import Data.Maybe

26+--import Data.Proxy

23#if !MIN_VERSION_base(4,9,0)

27#if !MIN_VERSION_base(4,9,0)

24import Data.Semigroup (Semigroup (..), (<>))

28import Data.Semigroup (Semigroup (..), (<>))

25#endif

29#endif

@@ -31,8 +35,12 @@ import Data.Tuple

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

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

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

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

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

37-- 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+ }

35deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithMove k p)

42deriving 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)

36deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithMove k p)

44deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithMove k p)

37deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (PatchMapWithMove k p)

45deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (PatchMapWithMove k p)

@@ -85,12 +93,7 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo

85 , _nodeInfo_to = Nothing

93 , _nodeInfo_to = Nothing

86 }

94 }

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'.

94insertMapKey

97insertMapKey

95 :: k -> PatchTarget p -> PatchMapWithMove k p

98 :: k -> PatchTarget p -> PatchMapWithMove k p

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

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

@@ -120,7 +123,8 @@ moveMapKey src dst

120-- . Map.delete a . Map.delete b $ map

123-- . Map.delete a . Map.delete b $ map

121-- @

124-- @

122swapMapKey

125swapMapKey

126+ :: (DecidablyEmpty p, Patch p)

123− :: (DecidablyEmpty p, Patch p) => Ord k => k -> k -> PatchMapWithMove k p

127+ => Ord k => k -> k -> PatchMapWithMove k p

124swapMapKey src dst

128swapMapKey src dst

125 | src == dst = mempty

129 | src == dst = mempty

126 | otherwise =

130 | otherwise =

@@ -129,7 +133,8 @@ swapMapKey src dst

129 , (src, NodeInfo (From_Move dst mempty) (Just dst))

133 , (src, NodeInfo (From_Move dst mempty) (Just dst))

130 ]

134 ]

131

135

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'.

133deleteMapKey

138deleteMapKey

134 :: k -> PatchMapWithMove k v

139 :: k -> PatchMapWithMove k v

135deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing

140deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing

@@ -144,7 +149,11 @@ unsafePatchMapWithMove = PatchMapWithMove

144-- | Apply the insertions, deletions, and moves to a given 'Map'

149-- | Apply the insertions, deletions, and moves to a given 'Map'

145instance (Ord k, Patch p) => Patch (PatchMapWithMove k p) where

150instance (Ord k, Patch p) => Patch (PatchMapWithMove k p) where

146 type PatchTarget (PatchMapWithMove k p) = Map k (PatchTarget p)

151 type PatchTarget (PatchMapWithMove k p) = Map k (PatchTarget p)

152+ -- TODO: return Nothing sometimes

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?

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)

148 where insertions = flip Map.mapMaybeWithKey m $ \_ ni -> case _nodeInfo_from ni of

157 where insertions = flip Map.mapMaybeWithKey m $ \_ ni -> case _nodeInfo_from ni of

149 From_Insert v -> Just v

158 From_Insert v -> Just v

150 From_Move k p -> applyAlways p <$> Map.lookup k old

159 From_Move k p -> applyAlways p <$> Map.lookup k old

@@ -308,7 +317,8 @@ instance ( Ord k

308 That b -> Just b

317 That b -> Just b

309

318

310--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here

319--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@

312instance ( Ord k

322instance ( Ord k

313 , Monoid p

323 , Monoid p

314 , DecidablyEmpty p

324 , DecidablyEmpty p