git.iko.soy/patch
on develop help sign in
Minor cleanup for Monoid PatchDMapWithMove
019b569Ryan Trinkle
src/Reflex/Patch/DMapWithMove.hs+16−20
compare with develop
unifiedsplit
@@ -110,19 +110,14 @@ instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where
110-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
110-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
111data Pair1 f g a = Pair1 (f a) (g a)
111data Pair1 f g a = Pair1 (f a) (g a)
112
112
113−-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
114−instance GCompare k => Semigroup (PatchDMapWithMove k v) where
115− (<>) = mappend
116−
117-- |Helper data structure used for composing patches using the monoid instance.
113-- |Helper data structure used for composing patches using the monoid instance.
118data Fixup k v a
114data Fixup k v a
119 = Fixup_Delete
115 = Fixup_Delete
120 | Fixup_Update (These (From k v a) (To k a))
116 | Fixup_Update (These (From k v a) (To k a))
121
117
122-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
118-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
123−instance GCompare k => Monoid (PatchDMapWithMove k v) where
119+instance GCompare k => Semigroup (PatchDMapWithMove k v) where
124− mempty = PatchDMapWithMove mempty
125− PatchDMapWithMove ma `mappend` PatchDMapWithMove mb = PatchDMapWithMove m
120+ PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
126 where
121 where
127 connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
122 connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
128 h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
123 h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
@@ -156,20 +151,21 @@ instance GCompare k => Monoid (PatchDMapWithMove k v) where
156 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
151 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
157 }
152 }
158 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
153 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
154+ getHere :: These a b -> Maybe a
155+ getHere = \case
156+ This a -> Just a
157+ These a _ -> Just a
158+ That _ -> Nothing
159+ getThere :: These a b -> Maybe b
160+ getThere = \case
161+ This _ -> Nothing
162+ These _ b -> Just b
163+ That b -> Just b
159
164
160−-- |Project the @a@ from a @'These' a b@, identical to @preview '_Here'@ but without using preview
165+-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
161−getHere :: These a b -> Maybe a
166+instance GCompare k => Monoid (PatchDMapWithMove k v) where
162−getHere = \case
167+ mempty = PatchDMapWithMove mempty
163− This a -> Just a
168+ mappend = (<>)
164− These a _ -> Just a
165− That _ -> Nothing
166−
167−-- |Project the @b@ from a @'These' a b@, identical to @preview '_There'@ but without using preview
168−getThere :: These a b -> Maybe b
169−getThere = \case
170− This _ -> Nothing
171− These _ b -> Just b
172− That b -> Just b
173
169
174{-
170{-
175mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
171mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v