56fcac1 · reflex · git.iko.soy

git.iko.soy/reflex

Additional cleanups

commit56fcac1bf971874ebfe7e1fa13133b9e71da27cb authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 8 Nov 2018, 00:10 (8 years ago) parent6c063e8

2 files changed+94−60

compare with develop

unifiedsplit

src/Reflex/Class.hs+41−26 src/Reflex/EventWriter/Base.hs+53−34

src/Reflex/Class.hs+41−26

@@ -48,6 +48,9 @@ module Reflex.Class

4848 , mergeMapIncremental

4949 , mergeMapIncrementalWithMove

5050 , mergeIntMapIncremental

51+ , coincidencePatchMap

52+ , coincidencePatchMapWithMove

53+ , coincidencePatchIntMap

5154 , mergeList

5255 , mergeWith

5356 , difference

@@ -193,6 +196,7 @@ import Data.These

193196import Data.Type.Coercion

194197import Reflex.FunctorMaybe

195198import Reflex.Patch

199+import qualified Reflex.Patch.MapWithMove as PatchMapWithMove

196200

197201import Debug.Trace (trace)

198202

@@ -865,42 +869,53 @@ switchHoldPromptOnly e0 e' = do

865869 eLag <- switch <$> hold e0 e'

866870 return $ coincidence $ leftmost [e', eLag <$ eLag]

867871

868−data ApplyElement p

869− = Append (PatchTarget p)

870− | Apply p

872+-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.

873+coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)

874+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case

875+ Nothing -> fmapCheap (const Nothing) e

876+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

877+

878+-- | See 'coincicencePatchMap'

879+coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)

880+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case

881+ Nothing -> fmapCheap (const Nothing) e

882+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

883+

884+-- | See 'coincicencePatchMap'

885+coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)

886+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of

887+ PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->

888+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

889+ PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->

890+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }

891+ PatchMapWithMove.From_Insert ev -> leftmost

892+ [ fforCheap ev $ \v ->

893+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }

894+ , fforCheap e $ \_ ->

895+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

896+ ]

871897

872−-- | Like 'switchHoldPromptOnly' but for a patchable data structure of events.

873898switchHoldPromptOnlyIncremental

874899 :: forall t m p pt w

875900 . ( Reflex t

876901 , MonadHold t m

877− , Functor p

878− , Functor pt

879− , FunctorMaybe pt

880− , Monoid (pt (Maybe w))

881− , Patch (p (Maybe w))

882− , PatchTarget (p (Maybe w)) ~ pt (Maybe w)

883902 , Patch (p (Event t w))

884903 , PatchTarget (p (Event t w)) ~ pt (Event t w)

904+ , Patch (p w)

905+ , PatchTarget (p w) ~ pt w

906+ , Monoid (pt w)

885907 )

886− => pt (Event t w)

908+ => (Incremental t (p (Event t w)) -> Event t (pt w))

909+ -> (Event t (p (Event t w)) -> Event t (p w))

910+ -> pt (Event t w)

887911 -> Event t (p (Event t w))

888− -> (p (Event t w) -> Event t (pt w))

889− -> (Incremental t (p (Event t w)) -> Event t (pt w))

890912 -> m (Event t (pt w))

891−switchHoldPromptOnlyIncremental e0 ee mergePatchNewElements mergePatchIncremental = do

892− let replaced :: Event t (ApplyElement (p (Maybe w)))

893− replaced = fmapCheap (Apply . (Nothing <$)) ee

894− new :: Event t (ApplyElement (p (Maybe w)))

895− new = fmapCheap (Append . fmap Just) $ coincidence $ fmapCheap mergePatchNewElements ee

896− held <- fmapCheap (Append . fmap Just) . mergePatchIncremental <$> holdIncremental e0 ee

897− let e = mergeList [held, replaced, new]

898− return $ fmap (fmapMaybe id . foldl' applyElement mempty) e

899− where

900− applyElement :: pt (Maybe w) -> ApplyElement (p (Maybe w)) -> pt (Maybe w)

901− applyElement pt = \case

902− Append new -> new <> pt

903− Apply p -> applyAlways p pt

913+switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do

914+ lag <- mergePatchIncremental <$> holdIncremental e0 e'

915+ pure $ ffor (align lag (coincidencePatch e')) $ \case

916+ This old -> old

917+ That new -> new `applyAlways` mempty

918+ These old new -> new `applyAlways` old

904919

905920instance Reflex t => Align (Event t) where

906921 nil = never

src/Reflex/EventWriter/Base.hs+53−34

@@ -4,7 +4,6 @@

44{-# LANGUAGE ExistentialQuantification #-}

55{-# LANGUAGE FlexibleInstances #-}

66{-# LANGUAGE GeneralizedNewtypeDeriving #-}

7−{-# LANGUAGE LambdaCase #-}

87{-# LANGUAGE MultiParamTypeClasses #-}

98{-# LANGUAGE Rank2Types #-}

109{-# LANGUAGE ScopedTypeVariables #-}

@@ -136,9 +135,9 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where

136135

137136instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

138137 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

139− traverseIntMapWithKeyWithAdjust = sequenceIntMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') (mergeIntMap . patchIntMapNewElementsMap) mergeIntIncremental

140− traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith (mergeMap . patchMapNewElementsMap) mergeMapIncremental

141− traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith (mergeMap . patchMapWithMoveNewElementsMap) mergeMapIncrementalWithMove

138+ traverseIntMapWithKeyWithAdjust = sequenceIntMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') mergeIntIncremental coincidencePatchIntMap

139+ traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith mergeMapIncremental coincidencePatchMap

140+ traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith mergeMapIncrementalWithMove coincidencePatchMapWithMove

142141

143142instance Requester t m => Requester t (EventWriterT t w m) where

144143 type Request (EventWriterT t w m) = Request m

@@ -161,19 +160,29 @@ runWithReplaceEventWriterTWith f a0 a' = do

161160 return (fst result0, fmapCheap fst result')

162161

163162-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceIntMapWithAdjust'.

164−sequenceIntMapWithAdjustEventWriterTWith :: forall t m p w v v'. (Reflex t, MonadHold t m, Semigroup w, Functor p, Patch (p (Event t w)), PatchTarget (p (Event t w)) ~ IntMap (Event t w), Patch (p (Maybe w)), PatchTarget (p (Maybe w)) ~ IntMap (Maybe w))

165− => ( (IntMap.Key -> v -> m (Event t w, v'))

166− -> IntMap v

167− -> Event t (p v)

168− -> EventWriterT t w m (IntMap (Event t w, v'), Event t (p (Event t w, v')))

169− )

170− -> (p (Event t w) -> Event t (IntMap w))

171− -> (Incremental t (p (Event t w)) -> Event t (IntMap w))

172− -> (IntMap.Key -> v -> EventWriterT t w m v')

173− -> IntMap v

174− -> Event t (p v)

175− -> EventWriterT t w m (IntMap v', Event t (p v'))

176−sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIncremental f dm0 dm' = do

163+sequenceIntMapWithAdjustEventWriterTWith

164+ :: forall t m p w v v'

165+ . ( Reflex t

166+ , MonadHold t m

167+ , Semigroup w

168+ , Functor p

169+ , Patch (p (Event t w))

170+ , PatchTarget (p (Event t w)) ~ IntMap (Event t w)

171+ , Patch (p w)

172+ , PatchTarget (p w) ~ IntMap w

173+ )

174+ => ( (IntMap.Key -> v -> m (Event t w, v'))

175+ -> IntMap v

176+ -> Event t (p v)

177+ -> EventWriterT t w m (IntMap (Event t w, v'), Event t (p (Event t w, v')))

178+ )

179+ -> (Incremental t (p (Event t w)) -> Event t (PatchTarget (p w)))

180+ -> (Event t (p (Event t w)) -> Event t (p w))

181+ -> (IntMap.Key -> v -> EventWriterT t w m v')

182+ -> IntMap v

183+ -> Event t (p v)

184+ -> EventWriterT t w m (IntMap v', Event t (p v'))

185+sequenceIntMapWithAdjustEventWriterTWith base mergePatchIncremental coincidencePatch f dm0 dm' = do

177186 let f' :: IntMap.Key -> v -> m (Event t w, v')

178187 f' k v = swap <$> runEventWriterT (f k v)

179188 (children0, children') <- base f' dm0 dm'

@@ -183,7 +192,7 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIn

183192 requests0 = fmap fst children0

184193 requests' :: Event t (p (Event t w))

185194 requests' = fmapCheap (fmap fst) children'

186− e <- switchHoldPromptOnlyIncremental requests0 requests' mergePatchNewElements mergePatchIncremental

195+ e <- switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch requests0 requests'

187196 tellEvent $ fforMaybeCheap e $ \m ->

188197 case IntMap.elems m of

189198 [] -> Nothing

@@ -191,21 +200,31 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIn

191200 return (result0, result')

192201

193202-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.

194−sequenceDMapWithAdjustEventWriterTWith :: forall t m p p' w k v v'. (Reflex t, MonadHold t m, Semigroup w, Patch (p' (Some k) (Event t w)), PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w), GCompare k, PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) (Maybe w)), PatchTarget (p' (Some k) (Maybe w)) ~ Map (Some k) (Maybe w), Functor (p' (Some k)))

195− => ( (forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a))

196− -> DMap k v

197− -> Event t (p k v)

198− -> EventWriterT t w m (DMap k (Compose ((,) (Event t w)) v'), Event t (p k (Compose ((,) (Event t w)) v')))

199− )

200− -> ((forall a. Compose ((,) (Event t w)) v' a -> v' a) -> p k (Compose ((,) (Event t w)) v') -> p k v')

201− -> ((forall a. Compose ((,) (Event t w)) v' a -> Event t w) -> p k (Compose ((,) (Event t w)) v') -> p' (Some k) (Event t w))

202− -> (p' (Some k) (Event t w) -> Event t (PatchTarget (p' (Some k) w)))

203− -> (Incremental t (p' (Some k) (Event t w)) -> Event t (Map (Some k) w))

204− -> (forall a. k a -> v a -> EventWriterT t w m (v' a))

205− -> DMap k v

206− -> Event t (p k v)

207− -> EventWriterT t w m (DMap k v', Event t (p k v'))

208−sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchNewElements mergePatchIncremental f dm0 dm' = do

203+sequenceDMapWithAdjustEventWriterTWith

204+ :: forall t m p p' w k v v'

205+ . ( Reflex t

206+ , MonadHold t m

207+ , Semigroup w

208+ , Patch (p' (Some k) (Event t w))

209+ , PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w)

210+ , GCompare k

211+ , Patch (p' (Some k) w)

212+ , PatchTarget (p' (Some k) w) ~ Map (Some k) w

213+ )

214+ => ( (forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a))

215+ -> DMap k v

216+ -> Event t (p k v)

217+ -> EventWriterT t w m (DMap k (Compose ((,) (Event t w)) v'), Event t (p k (Compose ((,) (Event t w)) v')))

218+ )

219+ -> ((forall a. Compose ((,) (Event t w)) v' a -> v' a) -> p k (Compose ((,) (Event t w)) v') -> p k v')

220+ -> ((forall a. Compose ((,) (Event t w)) v' a -> Event t w) -> p k (Compose ((,) (Event t w)) v') -> p' (Some k) (Event t w))

221+ -> (Incremental t (p' (Some k) (Event t w)) -> Event t (PatchTarget (p' (Some k) w)))

222+ -> (Event t (p' (Some k) (Event t w)) -> Event t (p' (Some k) w))

223+ -> (forall a. k a -> v a -> EventWriterT t w m (v' a))

224+ -> DMap k v

225+ -> Event t (p k v)

226+ -> EventWriterT t w m (DMap k v', Event t (p k v'))

227+sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchIncremental coincidencePatch f dm0 dm' = do

209228 let f' :: forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a)

210229 f' k v = Compose . swap <$> runEventWriterT (f k v)

211230 (children0, children') <- base f' dm0 dm'

@@ -215,7 +234,7 @@ sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchN

215234 requests0 = weakenDMapWith (fst . getCompose) children0

216235 requests' :: Event t (p' (Some k) (Event t w))

217236 requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose

218− e <- switchHoldPromptOnlyIncremental requests0 requests' mergePatchNewElements mergePatchIncremental

237+ e <- switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch requests0 requests'

219238 tellEvent $ fforMaybeCheap e $ \m ->

220239 case Map.elems m of

221240 [] -> Nothing