git.iko.soy/patch
on 08414ed help sign in
patch/src/Reflex/Requester/Base.hs
429 lines 23 kB history raw
1-- | This module provides 'RequesterT', the standard implementation of
2-- 'Requester'.
3{-# LANGUAGE AllowAmbiguousTypes #-}
4{-# LANGUAGE CPP #-}
5{-# LANGUAGE EmptyDataDecls #-}
6{-# LANGUAGE ExistentialQuantification #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE GADTs #-}
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE Rank2Types #-}
12{-# LANGUAGE RecursiveDo #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE StandaloneDeriving #-}
15{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE UndecidableInstances #-}
18#ifdef USE_REFLEX_OPTIMIZER
19{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
20#endif
21module Reflex.Requester.Base
22 ( RequesterT (..)
23 , runRequesterT
24 , runWithReplaceRequesterTWith
25 , traverseIntMapWithKeyWithAdjustRequesterTWith
26 , traverseDMapWithKeyWithAdjustRequesterTWith
27 , RequesterData
28 , RequesterDataKey
29 , traverseRequesterData
30 , requesterDataToList
31 , singletonRequesterData
32 ) where
34import Reflex.Class
35import Reflex.Adjustable.Class
36import Reflex.Dynamic
37import Reflex.Host.Class
38import Reflex.PerformEvent.Class
39import Reflex.PostBuild.Class
40import Reflex.Requester.Class
41import Reflex.TriggerEvent.Class
43import Control.Applicative (liftA2)
44import Control.Monad.Exception
45import Control.Monad.Identity
46import Control.Monad.Reader
47import Control.Monad.Ref
48import Control.Monad.State.Strict
49import Data.Bits
50import Data.Coerce
51import Data.Dependent.Map (DMap, DSum (..))
52import qualified Data.Dependent.Map as DMap
53import Data.Functor.Compose
54import Data.Functor.Misc
55import Data.IntMap.Strict (IntMap)
56import qualified Data.IntMap.Strict as IntMap
57import Data.Map (Map)
58import qualified Data.Map as Map
59import Data.Monoid ((<>))
60import Data.Proxy
61import qualified Data.Semigroup as S
62import Data.Some (Some)
63import qualified Data.Some as Some
64import Data.Type.Equality
65import Data.Unique.Tag
67import GHC.Exts (Any)
68import Unsafe.Coerce
70--TODO: Make this module type-safe
72newtype TagMap (f :: * -> *) = TagMap (IntMap Any)
74newtype RequesterData f = RequesterData (TagMap (Entry f))
76data RequesterDataKey a where
77 RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a
78 RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead
79 RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
80 RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
82singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f
83singletonRequesterData rdk v = case rdk of
84 RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v
85 RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v
86 RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
87 RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
89requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]
90requesterDataToList (RequesterData m) = do
91 k :=> Entry e <- tagMapToList m
92 case myKeyType k of
93 MyTagType_Single -> return $ RequesterDataKey_Single k :=> e
94 MyTagType_Multi -> do
95 (k', e') <- IntMap.toList e
96 k'' :=> e'' <- requesterDataToList e'
97 return $ RequesterDataKey_Multi k k' k'' :=> e''
98 MyTagType_Multi2 -> do
99 (k', e') <- Map.toList e
100 (k'', e'') <- IntMap.toList e'
101 k''' :=> e''' <- requesterDataToList e''
102 return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''
103 MyTagType_Multi3 -> do
104 (k', e') <- IntMap.toList e
105 (k'', e'') <- IntMap.toList e'
106 k''' :=> e''' <- requesterDataToList e''
107 return $ RequesterDataKey_Multi3 k k' k'' k''' :=> e'''
109singletonTagMap :: forall f a. MyTag a -> f a -> TagMap f
110singletonTagMap (MyTag k) v = TagMap $ IntMap.singleton k $ (unsafeCoerce :: f a -> Any) v
112tagMapToList :: forall f. TagMap f -> [DSum MyTag f]
113tagMapToList (TagMap m) = f <$> IntMap.toList m
114 where f :: (Int, Any) -> DSum MyTag f
115 f (k, v) = MyTag k :=> (unsafeCoerce :: Any -> f a) v
117traverseTagMapWithKey :: forall t f g. Applicative t => (forall a. MyTag a -> f a -> t (g a)) -> TagMap f -> t (TagMap g)
118traverseTagMapWithKey f (TagMap m) = TagMap <$> IntMap.traverseWithKey g m
119 where
120 g :: Int -> Any -> t Any
121 g k v = (unsafeCoerce :: g a -> Any) <$> f (MyTag k) ((unsafeCoerce :: Any -> f a) v)
123-- | Runs in reverse to accommodate for the fact that we accumulate it in reverse
124traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequesterData request -> m (RequesterData response)
125traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWithKey go m --TODO: reverse this, since our tags are in reverse order
126 where go :: forall x. MyTag x -> Entry request x -> m (Entry response x)
127 go k (Entry request) = Entry <$> case myKeyType k of
128 MyTagType_Single -> f request
129 MyTagType_Multi -> traverse (traverseRequesterData f) request
130 MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request
131 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request
133data MyTagType :: * -> * where
134 MyTagType_Single :: MyTagType (Single a)
135 MyTagType_Multi :: MyTagType Multi
136 MyTagType_Multi2 :: MyTagType (Multi2 k)
137 MyTagType_Multi3 :: MyTagType Multi3
139myKeyType :: MyTag x -> MyTagType x
140myKeyType (MyTag k) = case k .&. 0x3 of
141 0x0 -> unsafeCoerce MyTagType_Single
142 0x1 -> unsafeCoerce MyTagType_Multi
143 0x2 -> unsafeCoerce MyTagType_Multi2
144 0x3 -> unsafeCoerce MyTagType_Multi3
145 t -> error $ "Reflex.Requester.Base.myKeyType: no such key type" <> show t
147data Single a
148data Multi
149data Multi2 (k :: * -> *)
150data Multi3
152class MyTagTypeOffset x where
153 myTagTypeOffset :: proxy x -> Int
155instance MyTagTypeOffset (Single a) where
156 myTagTypeOffset _ = 0x0
158instance MyTagTypeOffset Multi where
159 myTagTypeOffset _ = 0x1
161instance MyTagTypeOffset (Multi2 k) where
162 myTagTypeOffset _ = 0x2
164instance MyTagTypeOffset Multi3 where
165 myTagTypeOffset _ = 0x3
167type family EntryContents request a where
168 EntryContents request (Single a) = request a
169 EntryContents request Multi = IntMap (RequesterData request)
170 EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))
171 EntryContents request Multi3 = IntMap (IntMap (RequesterData request))
173newtype Entry request x = Entry { unEntry :: EntryContents request x }
175{-# INLINE singleEntry #-}
176singleEntry :: f a -> Entry f (Single a)
177singleEntry = Entry
179{-# INLINE multiEntry #-}
180multiEntry :: IntMap (RequesterData f) -> Entry f Multi
181multiEntry = Entry
183{-# INLINE unMultiEntry #-}
184unMultiEntry :: Entry f Multi -> IntMap (RequesterData f)
185unMultiEntry = unEntry
187-- | We use a hack here to pretend we have x ~ request a; we don't want to use a GADT, because GADTs (even with zero-size existential contexts) can't be newtypes
188-- WARNING: This type should never be exposed. In particular, this is extremely unsound if a MyTag from one run of runRequesterT is ever compared against a MyTag from another
189newtype MyTag x = MyTag Int deriving (Show, Eq, Ord, Enum)
191newtype MyTagWrap (f :: * -> *) x = MyTagWrap Int deriving (Show, Eq, Ord, Enum)
193{-# INLINE castMyTagWrap #-}
194castMyTagWrap :: MyTagWrap f (Entry f x) -> MyTagWrap g (Entry g x)
195castMyTagWrap = coerce
197instance GEq MyTag where
198 (MyTag a) `geq` (MyTag b) =
199 if a == b
200 then Just $ unsafeCoerce Refl
201 else Nothing
203instance GCompare MyTag where
204 (MyTag a) `gcompare` (MyTag b) =
205 case a `compare` b of
206 LT -> GLT
207 EQ -> unsafeCoerce GEQ
208 GT -> GGT
210instance GEq (MyTagWrap f) where
211 (MyTagWrap a) `geq` (MyTagWrap b) =
212 if a == b
213 then Just $ unsafeCoerce Refl
214 else Nothing
216instance GCompare (MyTagWrap f) where
217 (MyTagWrap a) `gcompare` (MyTagWrap b) =
218 case a `compare` b of
219 LT -> GLT
220 EQ -> unsafeCoerce GEQ
221 GT -> GGT
223data RequesterState t (request :: * -> *) = RequesterState
224 { _requesterState_nextMyTag :: {-# UNPACK #-} !Int -- Starts at -4 and goes down by 4 each time, to accommodate two 'type' bits at the bottom
225 , _requesterState_requests :: ![(Int, Event t Any)]
226 }
228-- | A basic implementation of 'Requester'.
229newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequesterT :: StateT (RequesterState t request) (ReaderT (EventSelectorInt t Any) m) a }
230 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
231-- MonadAsyncException can't be derived on ghc-8.0.1; we use base-4.9.1 as a proxy for ghc-8.0.2
232#if MIN_VERSION_base(4,9,1)
233 , MonadAsyncException
234#endif
235 )
237deriving instance MonadSample t m => MonadSample t (RequesterT t request response m)
238deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)
239deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)
240deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
242-- TODO: Monoid and Semigroup can likely be derived once StateT has them.
243instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where
244 mempty = pure mempty
245 mappend = liftA2 mappend
247instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where
248 (<>) = liftA2 (S.<>)
251-- | Run a 'RequesterT' action. The resulting 'Event' will fire whenever
252-- requests are made, and responses should be provided in the input 'Event'.
253-- The 'Tag' keys will be used to return the responses to the same place the
254-- requests were issued.
256runRequesterT :: (Reflex t, Monad m)
257 => RequesterT t request response m a
258 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
259 -> m (a, Event t (RequesterData request)) --TODO: we need to hide these 'MyTag's here, because they're unsafe to mix in the wild
260runRequesterT (RequesterT a) responses = do
261 (result, s) <- runReaderT (runStateT a $ RequesterState (-4) []) $ fanInt $
262 coerceEvent responses
263 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
265instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
266 type Request (RequesterT t request response m) = request
267 type Response (RequesterT t request response m) = response
268 requesting = fmap coerceEvent . responseFromTag . castMyTagWrap <=< tagRequest . (coerceEvent :: Event t (request a) -> Event t (Entry request (Single a)))
269 requesting_ = void . tagRequest . fmapCheap singleEntry
271{-# INLINE tagRequest #-}
272tagRequest :: forall m x t request response. (Monad m, MyTagTypeOffset x) => Event t (Entry request x) -> RequesterT t request response m (MyTagWrap request (Entry request x))
273tagRequest req = do
274 old <- RequesterT get
275 let n = _requesterState_nextMyTag old .|. myTagTypeOffset (Proxy :: Proxy x)
276 t = MyTagWrap n
277 RequesterT $ put $ RequesterState
278 { _requesterState_nextMyTag = _requesterState_nextMyTag old - 0x4
279 , _requesterState_requests = (n, (unsafeCoerce :: Event t (Entry request x) -> Event t Any) req) : _requesterState_requests old
280 }
281 return t
283{-# INLINE responseFromTag #-}
284responseFromTag :: Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))
285responseFromTag (MyTagWrap t) = do
286 responses :: EventSelectorInt t Any <- RequesterT ask
287 return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t
289instance MonadTrans (RequesterT t request response) where
290 lift = RequesterT . lift . lift
292instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
293 type Performable (RequesterT t request response m) = Performable m
294 performEvent_ = lift . performEvent_
295 performEvent = lift . performEvent
297instance MonadRef m => MonadRef (RequesterT t request response m) where
298 type Ref (RequesterT t request response m) = Ref m
299 newRef = lift . newRef
300 readRef = lift . readRef
301 writeRef r = lift . writeRef r
303instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
304 newEventWithTrigger = lift . newEventWithTrigger
305 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
307instance MonadReader r m => MonadReader r (RequesterT t request response m) where
308 ask = lift ask
309 local f (RequesterT a) = RequesterT $ mapStateT (mapReaderT $ local f) a
310 reader = lift . reader
312instance (Reflex t, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (RequesterT t request response m) where
313 runWithReplace = runWithReplaceRequesterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
314 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') patchIntMapNewElementsMap mergeIntIncremental
315 {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
316 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental
317 traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove
319requesting' :: (MyTagTypeOffset x, Monad m) => Event t (Entry request x) -> RequesterT t request response m (Event t (Entry response x))
320requesting' = responseFromTag . castMyTagWrap <=< tagRequest
322{-# INLINABLE runWithReplaceRequesterTWith #-}
323runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
324 , MonadFix m
325 )
326 => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
327 -> RequesterT t request response m a
328 -> Event t (RequesterT t request response m b)
329 -> RequesterT t request response m (a, Event t b)
330runWithReplaceRequesterTWith f a0 a' = do
331 rec na' <- numberOccurrencesFrom 1 a'
332 responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requests --TODO: Investigate whether we can really get rid of the prompt stuff here
333 let responses' = fanInt responses
334 ((result0, requests0), v') <- f (runRequesterT a0 (selectInt responses' 0)) $ fmapCheap (\(n, a) -> fmap ((,) n) $ runRequesterT a $ selectInt responses' n) na'
335 requests <- holdDyn (fmapCheap (IntMap.singleton 0) requests0) $ fmapCheap (\(n, (_, reqs)) -> fmapCheap (IntMap.singleton n) reqs) v'
336 return (result0, fmapCheap (fst . snd) v')
338{-# INLINE traverseIntMapWithKeyWithAdjustRequesterTWith #-}
339traverseIntMapWithKeyWithAdjustRequesterTWith :: forall t request response m v v' p.
340 ( Reflex t
341 , MonadHold t m
342 , PatchTarget (p (Event t (IntMap (RequesterData request)))) ~ IntMap (Event t (IntMap (RequesterData request)))
343 , Patch (p (Event t (IntMap (RequesterData request))))
344 , Functor p
345 , MonadFix m
346 )
347 => ( (IntMap.Key -> (IntMap.Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
348 -> IntMap (IntMap.Key, v)
349 -> Event t (p (IntMap.Key, v))
350 -> RequesterT t request response m (IntMap (Event t (IntMap (RequesterData request)), v'), Event t (p (Event t (IntMap (RequesterData request)), v')))
351 )
352 -> (p (Event t (IntMap (RequesterData request))) -> IntMap (Event t (IntMap (RequesterData request))))
353 -> (Incremental t (p (Event t (IntMap (RequesterData request)))) -> Event t (IntMap (IntMap (RequesterData request))))
354 -> (IntMap.Key -> v -> RequesterT t request response m v')
355 -> IntMap v
356 -> Event t (p v)
357 -> RequesterT t request response m (IntMap v', Event t (p v'))
358traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIncremental f dm0 dm' = do
359 rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
360 let responses :: EventSelectorInt t (IntMap (RequesterData response))
361 responses = fanInt $ fmapCheap unpack response
362 unpack :: Entry response Multi3 -> IntMap (IntMap (RequesterData response))
363 unpack = unEntry
364 pack :: IntMap (IntMap (RequesterData request)) -> Entry request Multi3
365 pack = Entry
366 f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')
367 f' k (n, v) = do
368 (result, myRequests) <- runRequesterT (f k v) $ fmapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing fmapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?
369 return (fmapCheap (IntMap.singleton n) myRequests, result)
370 ndm' <- numberOccurrencesFrom 1 dm'
371 (children0, children') <- base f' (fmap ((,) 0) dm0) $ fmap (\(n, dm) -> fmap ((,) n) dm) ndm' --TODO: Avoid this somehow, probably by adding some sort of per-cohort information passing to Adjustable
372 let result0 = fmap snd children0
373 result' = fforCheap children' $ fmap snd
374 requests0 :: IntMap (Event t (IntMap (RequesterData request)))
375 requests0 = fmap fst children0
376 requests' :: Event t (p (Event t (IntMap (RequesterData request))))
377 requests' = fforCheap children' $ fmap fst
378 promptRequests :: Event t (IntMap (IntMap (RequesterData request)))
379 promptRequests = coincidence $ fmapCheap (mergeInt . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
380 requests <- holdIncremental requests0 requests'
381 return (result0, result')
383{-# INLINE traverseDMapWithKeyWithAdjustRequesterTWith #-}
384traverseDMapWithKeyWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
385 ( GCompare k
386 , Reflex t
387 , MonadHold t m
388 , PatchTarget (p' (Some k) (Event t (IntMap (RequesterData request)))) ~ Map (Some k) (Event t (IntMap (RequesterData request)))
389 , Patch (p' (Some k) (Event t (IntMap (RequesterData request))))
390 , MonadFix m
391 )
392 => (forall k' v1 v2. GCompare k'
393 => (forall a. k' a -> v1 a -> m (v2 a))
394 -> DMap k' v1
395 -> Event t (p k' v1)
396 -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
397 )
398 -> (forall v1 v2. (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
399 -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
400 -> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
401 -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
402 -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
403 -> DMap k v
404 -> Event t (p k v)
405 -> RequesterT t request response m (DMap k v', Event t (p k v'))
406traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
407 rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
408 let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))
409 responses = fanMap $ fmapCheap unpack response
410 unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))
411 unpack = unEntry
412 pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)
413 pack = Entry
414 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
415 f' k (Compose (n, v)) = do
416 (result, myRequests) <- runRequesterT (f k v) $ fmapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))
417 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
418 ndm' <- numberOccurrencesFrom 1 dm'
419 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
420 let result0 = DMap.map (snd . getCompose) children0
421 result' = fforCheap children' $ mapPatch $ snd . getCompose
422 requests0 :: Map (Some k) (Event t (IntMap (RequesterData request)))
423 requests0 = weakenDMapWith (fst . getCompose) children0
424 requests' :: Event t (p' (Some k) (Event t (IntMap (RequesterData request))))
425 requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose
426 promptRequests :: Event t (Map (Some k) (IntMap (RequesterData request)))
427 promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
428 requests <- holdIncremental requests0 requests'
429 return (result0, result')