git.iko.soy/patch
on 9104703 help sign in
patch/src/Reflex/Requester/Base.hs
419 lines 23 kB history raw
1-- | This module provides 'RequesterT', the standard implementation of
2-- 'Requester'.
3{-# LANGUAGE AllowAmbiguousTypes #-}
4{-# LANGUAGE BangPatterns #-}
5{-# LANGUAGE CPP #-}
6{-# LANGUAGE EmptyDataDecls #-}
7{-# LANGUAGE ExistentialQuantification #-}
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE GADTs #-}
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE MultiParamTypeClasses #-}
12{-# LANGUAGE Rank2Types #-}
13{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE StandaloneDeriving #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
19#ifdef USE_REFLEX_OPTIMIZER
20{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
21#endif
22module Reflex.Requester.Base
23 ( RequesterT (..)
24 , runRequesterT
25 , runWithReplaceRequesterTWith
26 , traverseIntMapWithKeyWithAdjustRequesterTWith
27 , traverseDMapWithKeyWithAdjustRequesterTWith
28 , RequesterData
29 , RequesterDataKey
30 , traverseRequesterData
31 , requesterDataToList
32 , singletonRequesterData
33 ) where
35import Reflex.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.Monad.Exception
44import Control.Monad.Identity
45import Control.Monad.Reader
46import Control.Monad.Ref
47import Control.Monad.State.Strict
48import Data.Bits
49import Data.Coerce
50import Data.Dependent.Map (DMap, DSum (..))
51import qualified Data.Dependent.Map as DMap
52import qualified Data.Some as Some
53import Data.FastMutableIntMap
54import Data.Functor.Compose
55import Data.Functor.Misc
56import Data.IntMap.Strict (IntMap)
57import qualified Data.IntMap.Strict as IntMap
58import Data.Map (Map)
59import qualified Data.Map as Map
60import Data.Monoid ((<>))
61import Data.Unique.Tag
62import Data.Some (Some)
63import Data.Type.Equality
64import Data.Proxy
66import GHC.Exts (Any)
67import Unsafe.Coerce
69--TODO: Make this module type-safe
71newtype TagMap (f :: * -> *) = TagMap (IntMap Any)
73newtype RequesterData f = RequesterData (TagMap (Entry f))
75data RequesterDataKey a where
76 RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a
77 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
78 RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
79 RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
81singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f
82singletonRequesterData rdk v = case rdk of
83 RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v
84 RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v
85 RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
86 RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
88requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]
89requesterDataToList (RequesterData m) = do
90 k :=> Entry e <- tagMapToList m
91 case myKeyType k of
92 MyTagType_Single -> return $ RequesterDataKey_Single k :=> e
93 MyTagType_Multi -> do
94 (k', e') <- IntMap.toList e
95 k'' :=> e'' <- requesterDataToList e'
96 return $ RequesterDataKey_Multi k k' k'' :=> e''
97 MyTagType_Multi2 -> do
98 (k', e') <- Map.toList e
99 (k'', e'') <- IntMap.toList e'
100 k''' :=> e''' <- requesterDataToList e''
101 return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''
102 MyTagType_Multi3 -> do
103 (k', e') <- IntMap.toList e
104 (k'', e'') <- IntMap.toList e'
105 k''' :=> e''' <- requesterDataToList e''
106 return $ RequesterDataKey_Multi3 k k' k'' k''' :=> e'''
108singletonTagMap :: forall f a. MyTag a -> f a -> TagMap f
109singletonTagMap (MyTag k) v = TagMap $ IntMap.singleton k $ (unsafeCoerce :: f a -> Any) v
111tagMapToList :: forall f. TagMap f -> [DSum MyTag f]
112tagMapToList (TagMap m) = fmap f $ IntMap.toList m
113 where f :: (Int, Any) -> DSum MyTag f
114 f (k, v) = MyTag k :=> ((unsafeCoerce :: Any -> f a) v)
116traverseTagMapWithKey :: forall t f g. Applicative t => (forall a. MyTag a -> f a -> t (g a)) -> TagMap f -> t (TagMap g)
117traverseTagMapWithKey f (TagMap m) = TagMap <$> IntMap.traverseWithKey g m
118 where
119 g :: Int -> Any -> t Any
120 g k v = (unsafeCoerce :: g a -> Any) <$> f (MyTag k) ((unsafeCoerce :: Any -> f a) v)
122-- | Runs in reverse to accommodate for the fact that we accumulate it in reverse
123traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequesterData request -> m (RequesterData response)
124traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWithKey go m --TODO: reverse this, since our tags are in reverse order
125 where go :: forall x. MyTag x -> Entry request x -> m (Entry response x)
126 go k (Entry request) = Entry <$> case myKeyType k of
127 MyTagType_Single -> f request
128 MyTagType_Multi -> traverse (traverseRequesterData f) request
129 MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request
130 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request
132data MyTagType :: * -> * where
133 MyTagType_Single :: MyTagType (Single a)
134 MyTagType_Multi :: MyTagType Multi
135 MyTagType_Multi2 :: MyTagType (Multi2 k)
136 MyTagType_Multi3 :: MyTagType Multi3
138myKeyType :: MyTag x -> MyTagType x
139myKeyType (MyTag k) = case k .&. 0x3 of
140 0x0 -> unsafeCoerce MyTagType_Single
141 0x1 -> unsafeCoerce MyTagType_Multi
142 0x2 -> unsafeCoerce MyTagType_Multi2
143 0x3 -> unsafeCoerce MyTagType_Multi3
144 t -> error $ "Reflex.Requester.Base.myKeyType: no such key type" <> show t
146data Single a
147data Multi
148data Multi2 (k :: * -> *)
149data Multi3
151class MyTagTypeOffset x where
152 myTagTypeOffset :: proxy x -> Int
154instance MyTagTypeOffset (Single a) where
155 myTagTypeOffset _ = 0x0
157instance MyTagTypeOffset Multi where
158 myTagTypeOffset _ = 0x1
160instance MyTagTypeOffset (Multi2 k) where
161 myTagTypeOffset _ = 0x2
163instance MyTagTypeOffset Multi3 where
164 myTagTypeOffset _ = 0x3
166type family EntryContents request a where
167 EntryContents request (Single a) = request a
168 EntryContents request Multi = IntMap (RequesterData request)
169 EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))
170 EntryContents request Multi3 = IntMap (IntMap (RequesterData request))
172newtype Entry request x = Entry { unEntry :: EntryContents request x }
174{-# INLINE singleEntry #-}
175singleEntry :: f a -> Entry f (Single a)
176singleEntry = Entry
178{-# INLINE multiEntry #-}
179multiEntry :: IntMap (RequesterData f) -> Entry f Multi
180multiEntry = Entry
182{-# INLINE unMultiEntry #-}
183unMultiEntry :: Entry f Multi -> IntMap (RequesterData f)
184unMultiEntry = unEntry
186-- | 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
187-- 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
188newtype MyTag x = MyTag Int deriving (Show, Eq, Ord, Enum)
190newtype MyTagWrap (f :: * -> *) x = MyTagWrap Int deriving (Show, Eq, Ord, Enum)
192{-# INLINE castMyTagWrap #-}
193castMyTagWrap :: MyTagWrap f (Entry f x) -> MyTagWrap g (Entry g x)
194castMyTagWrap = coerce
196instance GEq MyTag where
197 (MyTag a) `geq` (MyTag b) =
198 if a == b
199 then Just $ unsafeCoerce Refl
200 else Nothing
202instance GCompare MyTag where
203 (MyTag a) `gcompare` (MyTag b) =
204 case a `compare` b of
205 LT -> GLT
206 EQ -> unsafeCoerce GEQ
207 GT -> GGT
209instance GEq (MyTagWrap f) where
210 (MyTagWrap a) `geq` (MyTagWrap b) =
211 if a == b
212 then Just $ unsafeCoerce Refl
213 else Nothing
215instance GCompare (MyTagWrap f) where
216 (MyTagWrap a) `gcompare` (MyTagWrap b) =
217 case a `compare` b of
218 LT -> GLT
219 EQ -> unsafeCoerce GEQ
220 GT -> GGT
222data RequesterState t (request :: * -> *) = RequesterState
223 { _requesterState_nextMyTag :: {-# UNPACK #-} !Int -- Starts at -4 and goes down by 4 each time, to accommodate two 'type' bits at the bottom
224 , _requesterState_requests :: ![(Int, Event t Any)]
225 }
227-- | A basic implementation of 'Requester'.
228newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequesterT :: StateT (RequesterState t request) (ReaderT (EventSelectorInt t Any) m) a }
229 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
230-- MonadAsyncException can't be derived on ghc-8.0.1; we use base-4.9.1 as a proxy for ghc-8.0.2
231#if MIN_VERSION_base(4,9,1)
232 , MonadAsyncException
233#endif
234 )
236deriving instance MonadSample t m => MonadSample t (RequesterT t request response m)
237deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)
238deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)
239deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
241-- | Run a 'RequesterT' action. The resulting 'Event' will fire whenever
242-- requests are made, and responses should be provided in the input 'Event'.
243-- The 'Tag' keys will be used to return the responses to the same place the
244-- requests were issued.
246runRequesterT :: (Reflex t, Monad m)
247 => RequesterT t request response m a
248 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
249 -> m (a, Event t (RequesterData request)) --TODO: we need to hide these 'MyTag's here, because they're unsafe to mix in the wild
250runRequesterT (RequesterT a) responses = do
251 (result, s) <- runReaderT (runStateT a $ RequesterState (-4) []) $ fanInt $
252 coerceEvent responses
253 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
255instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
256 type Request (RequesterT t request response m) = request
257 type Response (RequesterT t request response m) = response
258 requesting = fmap coerceEvent . responseFromTag . castMyTagWrap <=< tagRequest . (coerceEvent :: Event t (request a) -> Event t (Entry request (Single a)))
259 requesting_ = void . tagRequest . fmapCheap singleEntry
261{-# INLINE tagRequest #-}
262tagRequest :: 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))
263tagRequest req = do
264 old <- RequesterT get
265 let n = _requesterState_nextMyTag old .|. myTagTypeOffset (Proxy :: Proxy x)
266 t = MyTagWrap n
267 RequesterT $ put $ RequesterState
268 { _requesterState_nextMyTag = _requesterState_nextMyTag old - 0x4
269 , _requesterState_requests = (n, (unsafeCoerce :: Event t (Entry request x) -> Event t Any) req) : _requesterState_requests old
270 }
271 return t
273{-# INLINE responseFromTag #-}
274responseFromTag :: (Monad m, Reflex t) => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))
275responseFromTag (MyTagWrap t) = do
276 responses :: EventSelectorInt t Any <- RequesterT ask
277 return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t
279instance MonadTrans (RequesterT t request response) where
280 lift = RequesterT . lift . lift
282instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
283 type Performable (RequesterT t request response m) = Performable m
284 performEvent_ = lift . performEvent_
285 performEvent = lift . performEvent
287instance MonadRef m => MonadRef (RequesterT t request response m) where
288 type Ref (RequesterT t request response m) = Ref m
289 newRef = lift . newRef
290 readRef = lift . readRef
291 writeRef r = lift . writeRef r
293instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
294 newEventWithTrigger = lift . newEventWithTrigger
295 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
297instance MonadReader r m => MonadReader r (RequesterT t request response m) where
298 ask = lift ask
299 local f (RequesterT a) = RequesterT $ mapStateT (mapReaderT $ local f) a
300 reader = lift . reader
302instance (Reflex t, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (RequesterT t request response m) where
303 runWithReplace = runWithReplaceRequesterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
304 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') patchIntMapNewElementsMap mergeIntIncremental
305 {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
306 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental
307 traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove
309requesting' :: (MyTagTypeOffset x, Monad m, Reflex t) => Event t (Entry request x) -> RequesterT t request response m (Event t (Entry response x))
310requesting' = responseFromTag . castMyTagWrap <=< tagRequest
312{-# INLINABLE runWithReplaceRequesterTWith #-}
313runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
314 , MonadFix m
315 )
316 => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
317 -> RequesterT t request response m a
318 -> Event t (RequesterT t request response m b)
319 -> RequesterT t request response m (a, Event t b)
320runWithReplaceRequesterTWith f a0 a' = do
321 rec na' <- numberOccurrencesFrom 1 a'
322 responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requests --TODO: Investigate whether we can really get rid of the prompt stuff here
323 let responses' = fanInt responses
324 ((result0, requests0), v') <- f (runRequesterT a0 (selectInt responses' 0)) $ fmapCheap (\(n, a) -> fmap ((,) n) $ runRequesterT a $ selectInt responses' n) na'
325 requests <- holdDyn (fmapCheap (IntMap.singleton 0) requests0) $ fmapCheap (\(n, (_, reqs)) -> fmapCheap (IntMap.singleton n) reqs) v'
326 return (result0, fmapCheap (fst . snd) v')
328{-# INLINE traverseIntMapWithKeyWithAdjustRequesterTWith #-}
329traverseIntMapWithKeyWithAdjustRequesterTWith :: forall t request response m v v' p.
330 ( Reflex t
331 , MonadHold t m
332 , PatchTarget (p (Event t (IntMap (RequesterData request)))) ~ IntMap (Event t (IntMap (RequesterData request)))
333 , Patch (p (Event t (IntMap (RequesterData request))))
334 , Functor p
335 , MonadFix m
336 )
337 => ( (IntMap.Key -> (IntMap.Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
338 -> IntMap (IntMap.Key, v)
339 -> Event t (p (IntMap.Key, v))
340 -> RequesterT t request response m (IntMap (Event t (IntMap (RequesterData request)), v'), Event t (p (Event t (IntMap (RequesterData request)), v')))
341 )
342 -> (p (Event t (IntMap (RequesterData request))) -> IntMap (Event t (IntMap (RequesterData request))))
343 -> (Incremental t (p (Event t (IntMap (RequesterData request)))) -> Event t (IntMap (IntMap (RequesterData request))))
344 -> (IntMap.Key -> v -> RequesterT t request response m v')
345 -> IntMap v
346 -> Event t (p v)
347 -> RequesterT t request response m (IntMap v', Event t (p v'))
348traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIncremental f dm0 dm' = do
349 rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
350 let responses :: EventSelectorInt t (IntMap (RequesterData response))
351 responses = fanInt $ fmapCheap unpack response
352 unpack :: Entry response Multi3 -> IntMap (IntMap (RequesterData response))
353 unpack = unEntry
354 pack :: IntMap (IntMap (RequesterData request)) -> Entry request Multi3
355 pack = Entry
356 f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')
357 f' k (n, v) = do
358 (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?
359 return (fmapCheap (IntMap.singleton n) myRequests, result)
360 ndm' <- numberOccurrencesFrom 1 dm'
361 (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
362 let result0 = fmap snd children0
363 result' = fforCheap children' $ fmap snd
364 requests0 :: IntMap (Event t (IntMap (RequesterData request)))
365 requests0 = fmap fst children0
366 requests' :: Event t (p (Event t (IntMap (RequesterData request))))
367 requests' = fforCheap children' $ fmap fst
368 promptRequests :: Event t (IntMap (IntMap (RequesterData request)))
369 promptRequests = coincidence $ fmapCheap (mergeInt . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
370 requests <- holdIncremental requests0 requests'
371 return (result0, result')
373{-# INLINE traverseDMapWithKeyWithAdjustRequesterTWith #-}
374traverseDMapWithKeyWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
375 ( GCompare k
376 , Reflex t
377 , MonadHold t m
378 , PatchTarget (p' (Some k) (Event t (IntMap (RequesterData request)))) ~ Map (Some k) (Event t (IntMap (RequesterData request)))
379 , Patch (p' (Some k) (Event t (IntMap (RequesterData request))))
380 , MonadFix m
381 )
382 => (forall k' v1 v2. GCompare k'
383 => (forall a. k' a -> v1 a -> m (v2 a))
384 -> DMap k' v1
385 -> Event t (p k' v1)
386 -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
387 )
388 -> (forall v1 v2. (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
389 -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
390 -> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
391 -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
392 -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
393 -> DMap k v
394 -> Event t (p k v)
395 -> RequesterT t request response m (DMap k v', Event t (p k v'))
396traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
397 rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
398 let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))
399 responses = fanMap $ fmapCheap unpack response
400 unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))
401 unpack = unEntry
402 pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)
403 pack = Entry
404 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
405 f' k (Compose (n, v)) = do
406 (result, myRequests) <- runRequesterT (f k v) $ fmapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))
407 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
408 ndm' <- numberOccurrencesFrom 1 dm'
409 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
410 let result0 = DMap.map (snd . getCompose) children0
411 result' = fforCheap children' $ mapPatch $ snd . getCompose
412 requests0 :: Map (Some k) (Event t (IntMap (RequesterData request)))
413 requests0 = weakenDMapWith (fst . getCompose) children0
414 requests' :: Event t (p' (Some k) (Event t (IntMap (RequesterData request))))
415 requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose
416 promptRequests :: Event t (Map (Some k) (IntMap (RequesterData request)))
417 promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
418 requests <- holdIncremental requests0 requests'
419 return (result0, result')