@@ -5,6 +5,8 @@
55{-# LANGUAGE LambdaCase #-}
66{-# LANGUAGE ScopedTypeVariables #-}
77{-# LANGUAGE TypeFamilies #-}
8+-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
9+-- another
810module Reflex.Patch.MapWithMove where
911
1012import Reflex.Patch.Class
@@ -20,19 +22,33 @@ import Data.Maybe
2022import qualified Data.Set as Set
2123import Data.Tuple
2224
23−-- | Patch a DMap with additions, deletions, and moves.
24−-- Invariants:
25−-- * The same source key may not be moved to two destination keys.
26−-- * Any key that is the source of a Move must also be edited
27−-- (otherwise, the Move would duplicate it)
25+-- | Patch a DMap with additions, deletions, and moves. Invariant: If key @k1@
26+-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
27+-- and vice versa. There should never be any unpaired From/To keys.
2828newtype PatchMapWithMove k v = PatchMapWithMove (Map k (NodeInfo k v)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
2929
30+-- | Holds the information about each key: where its new value should come from,
31+-- and where its old value should go to
3032data NodeInfo k v = NodeInfo
3133 { _nodeInfo_from :: !(From k v)
34+ -- ^ Where do we get the new value for this key?
3235 , _nodeInfo_to :: !(To k)
36+ -- ^ If the old value is being kept (i.e. moved rather than deleted or
37+ -- replaced), where is it going?
3338 }
3439 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)
3540
41+-- | Create a 'PatchMapWithMove', validating it
42+patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
43+patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
44+ where valid = forwardLinks == backwardLinks
45+ forwardLinks = Map.mapMaybe _nodeInfo_to m
46+ backwardLinks = Map.fromList $ catMaybes $ flip fmap (Map.toList m) $ \(to, v) ->
47+ case _nodeInfo_from v of
48+ From_Move from -> Just (from, to)
49+ _ -> Nothing
50+
51+-- | Extract the internal representation of the 'PatchMapWithMove'
3652unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
3753unPatchMapWithMove (PatchMapWithMove p) = p
3854
@@ -41,14 +57,19 @@ unPatchMapWithMove (PatchMapWithMove p) = p
4157unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
4258unsafePatchMapWithMove = PatchMapWithMove
4359
60+-- | Describe how a key's new value should be produced
4461data From k v
4562 = From_Insert v -- ^ Insert the given value here
4663 | From_Delete -- ^ Delete the existing value, if any, from here
4764 | From_Move !k -- ^ Move the value here from the given key
4865 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)
4966
67+-- | Describe where a key's old value will go. If this is 'Just', that means
68+-- the key's old value will be moved to the given other key; if it is 'Nothing',
69+-- that means it will be deleted.
5070type To = Maybe
5171
72+-- | Apply the insertions, deletions, and moves to a given 'Map'
5273instance Ord k => Patch (PatchMapWithMove k v) where
5374 type PatchTarget (PatchMapWithMove k v) = Map k v
5475 apply (PatchMapWithMove p) 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?
@@ -71,40 +92,9 @@ patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p
7192 From_Move _ -> Nothing
7293 From_Delete -> Nothing
7394
74−validPatchMapWithMove :: Ord k => PatchMapWithMove k v -> Bool
75−validPatchMapWithMove (PatchMapWithMove p) =
76− let f ni = case _nodeInfo_from ni of
77− From_Move k -> Just k
78− _ -> Nothing
79− moveSources = catMaybes $ f <$> Map.elems p
80− in and
81− [ -- All Moves must have unique source keys - a single source key can't be moved to two destinations
82− all (==1) $ Map.fromListWith (+) $ fmap (\k -> (k, 1 :: Integer )) moveSources
83− , -- All Move source keys must also be patched - since the value's being moved elsewhere, the original must either be Deleted or replaced (with Insert or Move)
84− all (isJust . flip Map.lookup p) moveSources
85− ]
86−
87−knownValidPatchMapWithMove :: [PatchMapWithMove Int Int]
88−knownValidPatchMapWithMove =
89− [ PatchMapWithMove mempty
90− , PatchMapWithMove $ Map.fromList
91− [ (1, NodeInfo (From_Move 2) $ Just 1)
92− , (2, NodeInfo (From_Move 1) $ Just 2)
93− ]
94− ]
95−
96−knownInvalidPatchMapWithMove :: [PatchMapWithMove Int Int]
97−knownInvalidPatchMapWithMove =
98− [ -- Invalid because we move 2 to 1, but don't specify what to do with 2
99− PatchMapWithMove $ Map.singleton 1 $ NodeInfo (From_Move 2) Nothing
100− , -- Invalid because we have multiple moves from 3
101− PatchMapWithMove $ Map.fromList
102− [ (1, NodeInfo (From_Move 3) Nothing)
103− , (2, NodeInfo (From_Move 3) Nothing)
104− , (3, NodeInfo From_Delete (Just 1))
105− ]
106− ]
107−
95+-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
96+-- its values using the given ordering function. The set keys of the 'Map' is
97+-- not changed.
10898patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
10999patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipWith g unsorted sorted
110100 where unsorted = Map.toList m
@@ -116,6 +106,9 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW
116106 let Just movingTo = Map.lookup from reverseMapping
117107 in Just (to, NodeInfo (From_Move from) $ Just movingTo)
118108
109+-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
110+-- will produce a 'Map' with the same values as the second 'Map' but with the
111+-- values sorted with the given ordering function.
119112patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
120113patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patch
121114 where oldByValue = Map.fromListWith Set.union $ swap . first Set.singleton <$> Map.toList oldByIndex
@@ -149,11 +142,15 @@ patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patch
149142 else Nothing
150143 patch = unsafePatchMapWithMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex
151144
145+-- | Change the 'From' value of a 'NodeInfo'
152146nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
153147nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
154148
149+-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
150+-- 'Applicative', 'Monad', etc.) action to get the new value
155151nodeInfoMapMFrom :: Functor f => (From k v -> f (From k v)) -> NodeInfo k v -> f (NodeInfo k v)
156152nodeInfoMapMFrom f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
157153
154+-- | Set the 'To' field of a 'NodeInfo'
158155nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
159156nodeInfoSetTo to ni = ni { _nodeInfo_to = to }