git.iko.soy/reflex
on develop help sign in
Update to use dependent-map-0.2.* and dependent-sum-0.3.*
commit26cd0fe54dcfca40325ce97534068d9d6f6b0e00 authorCale Gibbard <cgibbard@gmail.com> dateMon 30 Nov 2015, 15:36 (11 years ago) parent1db982f
9 files changed+126−113
compare with develop
unifiedsplit
default.nix+1−1 reflex.cabal+3−3 src/Data/Functor/Misc.hs+26−25 src/Reflex/Class.hs+20−16 src/Reflex/Dynamic.hs+22−17 src/Reflex/Host/Class.hs+5−4 src/Reflex/Spider/Internal.hs+43−41 test/Reflex/Pure.hs+4−4 test/Reflex/Test/CrossImpl.hs+2−2
default.nix+1−1
@@ -4,7 +4,7 @@
44}:
55mkDerivation {
66 pname = "reflex";
7− version = "0.3.2";
7+ version = "0.4.0";
88 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
99 buildDepends = [
1010 dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers
reflex.cabal+3−3
@@ -1,5 +1,5 @@
11Name: reflex
2−Version: 0.3.2
2+Version: 0.4.0
33Synopsis: Higher-order Functional Reactive Programming
44Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
55License: BSD3
@@ -17,8 +17,8 @@ library
1717 hs-source-dirs: src
1818 build-depends:
1919 base >= 4.7 && < 4.9,
20− dependent-sum == 0.2.*,
21− dependent-map == 0.1.*,
20+ dependent-sum == 0.3.*,
21+ dependent-map == 0.2.*,
2222 semigroups >= 0.16 && < 0.18,
2323 mtl >= 2.1 && < 2.3,
2424 containers == 0.5.*,
src/Data/Functor/Misc.hs+26−25
@@ -8,7 +8,7 @@ import Data.Dependent.Map (DMap, DSum (..))
88import qualified Data.Dependent.Map as DMap
99import Data.Typeable hiding (Refl)
1010import Data.These
11−import Data.Maybe
11+import Control.Monad.Identity
1212
1313data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
1414 WrapArg :: f a -> WrapArg g f (g a)
@@ -39,37 +39,38 @@ instance Ord k => GCompare (Const2 k v) where
3939 GT -> GGT
4040
4141{-# INLINE sequenceDmap #-}
42−sequenceDmap :: (Monad m, GCompare f) => DMap (WrapArg m f) -> m (DMap f)
43−sequenceDmap = DMap.foldrWithKey (\(WrapArg k) mv mx -> mx >>= \x -> mv >>= \v -> return $ DMap.insert k v x) (return DMap.empty)
42+sequenceDmap :: (Monad m, GCompare f) => DMap f m -> m (DMap f Identity)
43+sequenceDmap = DMap.foldrWithKey (\k mv mx -> mx >>= \x -> mv >>= \v -> return $ DMap.insert k (Identity v) x)
44+ (return DMap.empty)
4445
4546{-# INLINE combineDMapsWithKey #-}
46−combineDMapsWithKey :: forall f g h i. GCompare f => (forall a. f a -> These (g a) (h a) -> i a) -> DMap (WrapArg g f) -> DMap (WrapArg h f) -> DMap (WrapArg i f)
47+combineDMapsWithKey :: forall f g h i. GCompare f => (forall (a :: *). f a -> These (g a) (h a) -> i a) -> DMap f g -> DMap f h -> DMap f i
4748combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList mh)
48− where go :: [DSum (WrapArg g f)] -> [DSum (WrapArg h f)] -> [DSum (WrapArg i f)]
49− go [] hs = map (\(WrapArg hk :=> hv) -> WrapArg hk :=> f hk (That hv)) hs
50− go gs [] = map (\(WrapArg gk :=> gv) -> WrapArg gk :=> f gk (This gv)) gs
51− go gs@((WrapArg gk :=> gv) : gs') hs@((WrapArg hk :=> hv) : hs') = case gk `gcompare` hk of
52− GLT -> (WrapArg gk :=> f gk (This gv)) : go gs' hs
53− GEQ -> (WrapArg gk :=> f gk (These gv hv)) : go gs' hs'
54− GGT -> (WrapArg hk :=> f hk (That hv)) : go gs hs'
49+ where go :: [DSum f g] -> [DSum f h] -> [DSum f i]
50+ go [] hs = map (\(hk :=> hv) -> hk :=> f hk (That hv)) hs
51+ go gs [] = map (\(gk :=> gv) -> gk :=> f gk (This gv)) gs
52+ go gs@((gk :=> gv) : gs') hs@((hk :=> hv) : hs') = case gk `gcompare` hk of
53+ GLT -> (gk :=> f gk (This gv)) : go gs' hs
54+ GEQ -> (gk :=> f gk (These gv hv)) : go gs' hs'
55+ GGT -> (hk :=> f hk (That hv)) : go gs hs'
5556
56−wrapDMap :: (forall a. a -> f a) -> DMap k -> DMap (WrapArg f k)
57−wrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> WrapArg k :=> f v) . DMap.toAscList
57+wrapDMap :: (forall a. a -> f a) -> DMap k Identity -> DMap k f
58+wrapDMap f = DMap.fromDistinctAscList . map (\(k :=> Identity v) -> k :=> f v) . DMap.toAscList
5859
59−rewrapDMap :: (forall a. f a -> g a) -> DMap (WrapArg f k) -> DMap (WrapArg g k)
60−rewrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> WrapArg k :=> f v) . DMap.toAscList
60+rewrapDMap :: (forall (a :: *). f a -> g a) -> DMap k f -> DMap k g
61+rewrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> k :=> f v) . DMap.toAscList
6162
62−unwrapDMap :: (forall a. f a -> a) -> DMap (WrapArg f k) -> DMap k
63−unwrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> k :=> f v) . DMap.toAscList
63+unwrapDMap :: (forall a. f a -> a) -> DMap k f -> DMap k Identity
64+unwrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> k :=> Identity (f v)) . DMap.toAscList
6465
65−unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap (WrapArg f k) -> DMap k
66−unwrapDMapMaybe f = DMap.fromDistinctAscList . catMaybes . map (\(WrapArg k :=> v) -> fmap (k :=>) $ f v) . DMap.toAscList
66+unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap k f -> DMap k Identity
67+unwrapDMapMaybe f m = DMap.fromDistinctAscList [k :=> Identity w | (k :=> v) <- DMap.toAscList m, Just w <- [f v]]
6768
68−mapToDMap :: Map k v -> DMap (Const2 k v)
69−mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
69+mapToDMap :: Map k v -> DMap (Const2 k v) Identity
70+mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
7071
71−mapWithFunctorToDMap :: Map k (f v) -> DMap (WrapArg f (Const2 k v))
72−mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> WrapArg (Const2 k) :=> v) . Map.toAscList
72+mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
73+mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> (Const2 k) :=> v) . Map.toAscList
7374
74−dmapToMap :: DMap (Const2 k v) -> Map k v
75−dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, v)) . DMap.toAscList
75+dmapToMap :: DMap (Const2 k v) Identity -> Map k v
76+dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
src/Reflex/Class.hs+20−16
@@ -45,9 +45,9 @@ class (MonadHold t (PushM t), MonadSample t (PullM t), MonadFix (PushM t), Funct
4545 -- | A monad for doing complex pull-based calculations efficiently
4646 type PullM t :: * -> *
4747 -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
48− merge :: GCompare k => DMap (WrapArg (Event t) k) -> Event t (DMap k) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
48+ merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
4949 -- | Efficiently fan-out an event to many destinations. This function should be partially applied, and then the result applied repeatedly to create child events
50− fan :: GCompare k => Event t (DMap k) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
50+ fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
5151 -- | Create an Event that will occur whenever the currently-selected input Event occurs
5252 switch :: Behavior t (Event t a) -> Event t a
5353 -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
@@ -273,30 +273,30 @@ instance GShow (EitherTag l r) where
273273 LeftTag -> showString "LeftTag"
274274 RightTag -> showString "RightTag"
275275
276−instance (Show l, Show r) => ShowTag (EitherTag l r) where
277− showTaggedPrec t n a = case t of
276+instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
277+ showTaggedPrec t n (Identity a) = case t of
278278 LeftTag -> showsPrec n a
279279 RightTag -> showsPrec n a
280280
281281-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
282−eitherToDSum :: Either a b -> DSum (EitherTag a b)
282+eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
283283eitherToDSum = \case
284− Left a -> LeftTag :=> a
285− Right b -> RightTag :=> b
284+ Left a -> (LeftTag :=> Identity a)
285+ Right b -> (RightTag :=> Identity b)
286286
287287-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
288−dsumToEither :: DSum (EitherTag a b) -> Either a b
288+dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
289289dsumToEither = \case
290− LeftTag :=> a -> Left a
291− RightTag :=> b -> Right b
290+ (LeftTag :=> Identity a) -> Left a
291+ (RightTag :=> Identity b) -> Right b
292292
293293-- | Extract the values of a 'DMap' of 'EitherTag's.
294−dmapToThese :: DMap (EitherTag a b) -> Maybe (These a b)
294+dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
295295dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
296296 (Nothing, Nothing) -> Nothing
297− (Just a, Nothing) -> Just $ This a
298− (Nothing, Just b) -> Just $ That b
299− (Just a, Just b) -> Just $ These a b
297+ (Just (Identity a), Nothing) -> Just $ This a
298+ (Nothing, Just (Identity b)) -> Just $ That b
299+ (Just (Identity a), Just (Identity b)) -> Just $ These a b
300300
301301-- | Create a new 'Event' that occurs if at least one of the supplied
302302-- 'Event's occurs. If both occur at the same time they are combined
@@ -320,7 +320,11 @@ instance (Semigroup a, Reflex t) => Monoid (Event t a) where
320320-- in the list occurs. If multiple occur at the same time they are
321321-- folded from the left with the given function.
322322mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
323−mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) $ merge $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
323+mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
324+ . merge
325+ . DMap.fromAscList
326+ . map (\(k, v) -> (Const2 k) :=> v)
327+ $ zip [0 :: Int ..] es
324328
325329-- | Create a new 'Event' that occurs if at least one of the 'Event's
326330-- in the list occurs. If multiple occur at the same time the value is
@@ -356,7 +360,7 @@ switchPromptly ea0 eea = do
356360
357361instance Reflex t => Align (Event t) where
358362 nil = never
359− align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [WrapArg LeftTag :=> ea, WrapArg RightTag :=> eb]
363+ align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
360364
361365-- | Create a new 'Event' that only occurs if the supplied 'Event'
362366-- occurs and the 'Behavior' is true at the time of occurence.
src/Reflex/Dynamic.hs+22−17
@@ -222,26 +222,26 @@ splitDyn d = liftM2 (,) (mapDyn fst d) (mapDyn snd d)
222222-- | Merge the 'Dynamic' values using their 'Monoid' instance.
223223mconcatDyn :: forall t m a. (Reflex t, MonadHold t m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
224224mconcatDyn es = do
225− ddm :: Dynamic t (DMap (Const2 Int a)) <- distributeDMapOverDyn $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
226− mapDyn (mconcat . map (\(Const2 _ :=> v) -> v) . DMap.toList) ddm
225+ ddm :: Dynamic t (DMap (Const2 Int a) Identity) <- distributeDMapOverDyn . DMap.fromList . map (\(k, v) -> Const2 k :=> v) $ zip [0 :: Int ..] es
226+ mapDyn (mconcat . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) ddm
227227
228228-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of
229229-- Dynamic values.
230−distributeDMapOverDyn :: forall t m k. (Reflex t, MonadHold t m, GCompare k) => DMap (WrapArg (Dynamic t) k) -> m (Dynamic t (DMap k))
230+distributeDMapOverDyn :: forall t m k. (Reflex t, MonadHold t m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
231231distributeDMapOverDyn dm = case DMap.toList dm of
232232 [] -> return $ constDyn DMap.empty
233− [WrapArg k :=> v] -> mapDyn (DMap.singleton k) v
233+ [k :=> v] -> mapDyn (DMap.singleton k . Identity) v
234234 _ -> do
235235 let edmPre = merge $ rewrapDMap updated dm
236− edm :: Event t (DMap k) = flip push edmPre $ \o -> return . Just =<< do
236+ edm :: Event t (DMap k Identity) = flip push edmPre $ \o -> return . Just =<< do
237237 let f _ = \case
238238 This origDyn -> sample $ current origDyn
239239 That _ -> error "distributeDMapOverDyn: should be impossible to have an event occurring that is not present in the original DMap"
240240 These _ (Identity newVal) -> return newVal
241241 sequenceDmap $ combineDMapsWithKey f dm (wrapDMap Identity o)
242− dm0 :: Behavior t (DMap k) = pull $ do
243− liftM DMap.fromList $ forM (DMap.toList dm) $ \(WrapArg k :=> dv) -> liftM (k :=>) $ sample $ current dv
244− bbdm :: Behavior t (Behavior t (DMap k)) <- hold dm0 $ fmap constant edm
242+ dm0 :: Behavior t (DMap k Identity) = pull $ do
243+ liftM DMap.fromList . forM (DMap.toList dm) $ \(k :=> dv) -> liftM ((k :=>) . Identity) . sample $ current dv
244+ bbdm :: Behavior t (Behavior t (DMap k Identity)) <- hold dm0 $ fmap constant edm
245245 let bdm = pull $ sample =<< sample bbdm
246246 return $ Dynamic bdm edm
247247
@@ -379,7 +379,12 @@ data Demux t k = Demux { demuxValue :: Behavior t k
379379
380380-- | Demultiplex an input value to a 'Demux' with many outputs. At any given time, whichever output is indicated by the given 'Dynamic' will be 'True'.
381381demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
382−demux k = Demux (current k) (fan $ attachWith (\k0 k1 -> if k0 == k1 then DMap.empty else DMap.fromList [Const2 k0 :=> False, Const2 k1 :=> True]) (current k) (updated k))
382+demux k = Demux (current k)
383+ (fan $ attachWith (\k0 k1 -> if k0 == k1
384+ then DMap.empty
385+ else DMap.fromList [Const2 k0 :=> Identity False,
386+ Const2 k1 :=> Identity True])
387+ (current k) (updated k))
383388
384389--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
385390-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
@@ -417,16 +422,16 @@ data HListPtr l a where
417422 HHeadPtr :: HListPtr (h ': t) h
418423 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
419424
420−fhlistToDMap :: forall f l. FHList f l -> DMap (WrapArg f (HListPtr l))
425+fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
421426fhlistToDMap = DMap.fromList . go
422− where go :: forall l'. FHList f l' -> [DSum (WrapArg f (HListPtr l'))]
427+ where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
423428 go = \case
424429 FHNil -> []
425− FHCons h t -> (WrapArg HHeadPtr :=> h) : map (\(WrapArg p :=> v) -> WrapArg (HTailPtr p) :=> v) (go t)
430+ FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> (HTailPtr p) :=> v) (go t)
426431
427432class RebuildSortedHList l where
428− rebuildSortedFHList :: [DSum (WrapArg f (HListPtr l))] -> FHList f l
429− rebuildSortedHList :: [DSum (HListPtr l)] -> HList l
433+ rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
434+ rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
430435
431436instance RebuildSortedHList '[] where
432437 rebuildSortedFHList l = case l of
@@ -438,13 +443,13 @@ instance RebuildSortedHList '[] where
438443
439444instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
440445 rebuildSortedFHList l = case l of
441− ((WrapArg HHeadPtr :=> h) : t) -> FHCons h $ rebuildSortedFHList $ map (\(WrapArg (HTailPtr p) :=> v) -> WrapArg p :=> v) t
446+ ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
442447 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
443448 rebuildSortedHList l = case l of
444− ((HHeadPtr :=> h) : t) -> HCons h $ rebuildSortedHList $ map (\(HTailPtr p :=> v) -> p :=> v) t
449+ ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
445450 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
446451
447−dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) -> HList l
452+dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
448453dmapToHList = rebuildSortedHList . DMap.toList
449454
450455distributeFHListOverDyn :: forall t m l. (Reflex t, MonadHold t m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
src/Reflex/Host/Class.hs+5−4
@@ -6,6 +6,7 @@ import Reflex.Class
66import Control.Applicative
77import Control.Monad
88import Control.Monad.Fix
9+import Control.Monad.Identity
910import Control.Monad.Trans
1011import Control.Monad.Trans.Reader (ReaderT())
1112import Control.Monad.Trans.Writer (WriterT())
@@ -84,7 +85,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, Mona
8485 -- The main loop waits for external events to happen (such as keyboard input or a mouse click)
8586 -- and then fires the corresponding events using this function. The read callback can be used
8687 -- to read output events and perform a corresponding response action to the external event.
87− fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a
88+ fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> (ReadPhase m a) -> m a
8889
8990 -- | Run a frame without any events firing.
9091 --
@@ -96,7 +97,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, Mona
9697 runHostFrame :: HostFrame t a -> m a
9798
9899-- | Like 'fireEventsAndRead', but without reading any events.
99−fireEvents :: MonadReflexHost t m => [DSum (EventTrigger t)] -> m ()
100+fireEvents :: MonadReflexHost t m => [DSum (EventTrigger t) Identity] -> m ()
100101fireEvents dm = fireEventsAndRead dm $ return ()
101102{-# INLINE fireEvents #-}
102103
@@ -120,14 +121,14 @@ fireEventRef mtRef input = do
120121 mt <- readRef mtRef
121122 case mt of
122123 Nothing -> return ()
123− Just trigger -> fireEvents [trigger :=> input]
124+ Just trigger -> fireEvents [trigger :=> Identity input]
124125
125126fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
126127fireEventRefAndRead mtRef input e = do
127128 mt <- readRef mtRef
128129 case mt of
129130 Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire
130− Just trigger -> fireEventsAndRead [trigger :=> input] $ do
131+ Just trigger -> fireEventsAndRead [trigger :=> Identity input] $ do
131132 mGetValue <- readEvent e
132133 case mGetValue of
133134 Nothing -> return Nothing
src/Reflex/Spider/Internal.hs+43−41
@@ -9,13 +9,13 @@ import System.Mem.Weak
99import Data.Foldable
1010import Data.Traversable
1111import Control.Monad hiding (mapM, mapM_, forM_, forM, sequence)
12+import Control.Monad.Identity hiding (mapM, mapM_, forM_, forM, sequence)
1213import Control.Monad.Reader hiding (mapM, mapM_, forM_, forM, sequence)
1314import GHC.Exts
1415import Control.Applicative -- Unconditionally import, because otherwise it breaks on GHC 7.10.1RC2
1516import Data.Dependent.Map (DMap, DSum (..))
1617import qualified Data.Dependent.Map as DMap
1718import Data.GADT.Compare
18−import Data.Functor.Misc
1919import Data.Maybe
2020import Data.IntMap (IntMap)
2121import qualified Data.IntMap as IntMap
@@ -139,7 +139,7 @@ scheduleClear r = EventM $ do
139139 clears <- asks eventEnvClears
140140 liftIO $ modifyIORef' clears (SomeMaybeIORef r :)
141141
142−scheduleRootClear :: IORef (DMap k) -> EventM ()
142+scheduleRootClear :: IORef (DMap k Identity) -> EventM ()
143143scheduleRootClear r = EventM $ do
144144 clears <- asks eventEnvRootClears
145145 liftIO $ modifyIORef' clears (SomeDMapIORef r :)
@@ -223,8 +223,8 @@ data RootSubscribed a
223223 }
224224
225225data Root (k :: * -> *)
226− = Root { rootOccurrence :: !(IORef (DMap k)) -- The currently-firing occurrence of this event
227− , rootSubscribed :: !(IORef (DMap (WrapArg RootSubscribed k)))
226+ = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
227+ , rootSubscribed :: !(IORef (DMap k RootSubscribed))
228228 , rootInit :: !(forall a. k a -> RootTrigger a -> IO (IO ()))
229229 }
230230
@@ -251,12 +251,12 @@ data Push a b
251251 }
252252
253253data MergeSubscribed k
254− = MergeSubscribed { mergeSubscribedOccurrence :: !(IORef (Maybe (DMap k)))
255− , mergeSubscribedAccum :: !(IORef (DMap k)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence
254+ = MergeSubscribed { mergeSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
255+ , mergeSubscribedAccum :: !(IORef (DMap k Identity)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence
256256 , mergeSubscribedHeight :: !(IORef Int)
257− , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k)])
257+ , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k Identity)])
258258 , mergeSubscribedSelf :: !Any -- Hold all our Subscribers in memory
259− , mergeSubscribedParents :: !(DMap (WrapArg EventSubscribed k))
259+ , mergeSubscribedParents :: !(DMap k EventSubscribed)
260260#ifdef DEBUG_NODEIDS
261261 , mergeSubscribedNodeId :: Int
262262#endif
@@ -264,7 +264,7 @@ data MergeSubscribed k
264264
265265--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)
266266data Merge k
267− = Merge { mergeParents :: !(DMap (WrapArg Event k))
267+ = Merge { mergeParents :: !(DMap k Event)
268268 , mergeSubscribed :: !(IORef (Maybe (MergeSubscribed k))) --TODO: Can we replace this with an unsafePerformIO thunk?
269269 }
270270
@@ -283,16 +283,16 @@ instance GCompare k => GCompare (FanSubscriberKey k) where
283283 GGT -> GGT
284284
285285data FanSubscribed k
286− = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))
287− , fanSubscribedParent :: !(EventSubscribed (DMap k))
288− , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k))
286+ = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k) Identity))
287+ , fanSubscribedParent :: !(EventSubscribed (DMap k Identity))
288+ , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k Identity))
289289#ifdef DEBUG_NODEIDS
290290 , fanSubscribedNodeId :: Int
291291#endif
292292 }
293293
294294data Fan k
295− = Fan { fanParent :: !(Event (DMap k))
295+ = Fan { fanParent :: !(Event (DMap k Identity))
296296 , fanSubscribed :: !(IORef (Maybe (FanSubscribed k)))
297297 }
298298
@@ -354,7 +354,7 @@ deRefWeakSubscriber ws = case ws of
354354data Subscriber a
355355 = forall b. SubscriberPush !(a -> EventM (Maybe b)) (PushSubscribed a b)
356356 | forall k. GCompare k => SubscriberMerge !(k a) (MergeSubscribed k) --TODO: Can we inline the GCompare?
357− | forall k. (GCompare k, a ~ DMap k) => SubscriberFan (FanSubscribed k)
357+ | forall k. (GCompare k, a ~ DMap k Identity) => SubscriberFan (FanSubscribed k)
358358 | SubscriberHold !(Hold a)
359359 | SubscriberSwitch (SwitchSubscribed a)
360360 | forall b. a ~ Event b => SubscriberCoincidenceOuter (CoincidenceSubscribed b)
@@ -374,7 +374,7 @@ data Event a
374374 = forall k. GCompare k => EventRoot !(k a) !(Root k)
375375 | EventNever
376376 | forall b. EventPush !(Push b a)
377− | forall k. (GCompare k, a ~ DMap k) => EventMerge !(Merge k)
377+ | forall k. (GCompare k, a ~ DMap k Identity) => EventMerge !(Merge k)
378378 | forall k. GCompare k => EventFan !(k a) !(Fan k)
379379 | EventSwitch !(Switch a)
380380 | EventCoincidence !(Coincidence a)
@@ -393,7 +393,7 @@ data EventSubscribed a
393393 = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed a)
394394 | EventSubscribedNever
395395 | forall b. EventSubscribedPush !(PushSubscribed b a)
396− | forall k. (GCompare k, a ~ DMap k) => EventSubscribedMerge !(MergeSubscribed k)
396+ | forall k. (GCompare k, a ~ DMap k Identity) => EventSubscribedMerge !(MergeSubscribed k)
397397 | forall k. GCompare k => EventSubscribedFan !(k a) !(FanSubscribed k)
398398 | EventSubscribedSwitch !(SwitchSubscribed a)
399399 | EventSubscribedCoincidence !(CoincidenceSubscribed a)
@@ -424,7 +424,7 @@ newSubscriberHold :: Hold a -> IO (Subscriber a)
424424newSubscriberHold h = return $! SubscriberHold h
425425
426426{-# NOINLINE newSubscriberFan #-}
427−newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k))
427+newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k Identity))
428428newSubscriberFan subd = return $! SubscriberFan subd
429429
430430{-# NOINLINE newSubscriberSwitch #-}
@@ -519,7 +519,7 @@ propagateAndUpdateSubscribersRef subscribersRef a = do
519519 liftIO $ modifyIORef' subscribersRef (++stillAlive)
520520
521521-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
522−run :: [DSum RootTrigger] -> ResultM b -> IO b
522+run :: [DSum RootTrigger Identity] -> ResultM b -> IO b
523523run roots after = do
524524 when debugPropagate $ putStrLn "Running an event frame"
525525 result <- runFrame $ do
@@ -532,7 +532,7 @@ run roots after = do
532532 then do scheduleRootClear occRef
533533 return $ Just r
534534 else return Nothing
535− forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (subscribersRef, _, _) :=> a) -> do
535+ forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (subscribersRef, _, _) :=> Identity a) -> do
536536 propagateAndUpdateSubscribersRef subscribersRef a
537537 delayedRef <- EventM $ asks eventEnvDelayedMerges
538538 let go = do
@@ -565,7 +565,7 @@ run roots after = do
565565
566566data SomeMaybeIORef = forall a. SomeMaybeIORef (IORef (Maybe a))
567567
568−data SomeDMapIORef = forall k. SomeDMapIORef (IORef (DMap k))
568+data SomeDMapIORef = forall k. SomeDMapIORef (IORef (DMap k Identity))
569569
570570data SomeAssignment = forall a. SomeAssignment (Hold a) a
571571
@@ -611,7 +611,7 @@ propagate a subscribers = do
611611 SubscriberMerge k subscribed -> do
612612 when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
613613 oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
614− liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
614+ liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k (Identity a) oldM
615615 when (DMap.null oldM) $ do -- Only schedule the firing once
616616 height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
617617 --TODO: assertions about height
@@ -622,17 +622,19 @@ propagate a subscribers = do
622622 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
623623 when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
624624 --TODO: We need a better DMap intersection; here, we are assuming that the number of firing keys is small and the number of subscribers is large
625− forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
625+ forM_ (DMap.toList a) $ \(k :=> Identity v) -> case DMap.lookup (FanSubscriberKey k) subs of
626626 Nothing -> do
627627 when debugPropagate $ liftIO $ putStrLn "No subscriber for key"
628628 return ()
629− Just subsubs -> do
629+ Just (Identity subsubs) -> do
630630 _ <- propagate v subsubs --TODO: use the value of this
631631 return ()
632632 --TODO: The following is way too slow to do all the time
633− subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> subsubs) -> do
633+ subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> Identity subsubs) -> do
634634 subsubs' <- traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subsubs (const $ return ())
635− return $ if null subsubs' then Nothing else Just $ FanSubscriberKey k :=> subsubs') :: DSum (FanSubscriberKey k) -> IO (Maybe (DSum (FanSubscriberKey k))))
635+ return $ if null subsubs'
636+ then Nothing
637+ else Just $ FanSubscriberKey k :=> Identity subsubs') :: DSum (FanSubscriberKey k) Identity -> IO (Maybe (DSum (FanSubscriberKey k) Identity)))
636638 liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
637639 SubscriberHold h -> do
638640 invalidators <- liftIO $ readIORef $ holdInvalidators h
@@ -731,7 +733,7 @@ readBehaviorTracked b = case b of
731733
732734readEvent :: Event a -> ResultM (Maybe a)
733735readEvent e = case e of
734− EventRoot k r -> liftIO $ liftM (DMap.lookup k) $ readIORef $ rootOccurrence r
736+ EventRoot k r -> liftIO . liftM (fmap runIdentity . DMap.lookup k) . readIORef $ rootOccurrence r
735737 EventNever -> return Nothing
736738 EventPush p -> do
737739 subscribed <- getPushSubscribed p
@@ -747,7 +749,7 @@ readEvent e = case e of
747749 return result
748750 EventFan k f -> do
749751 parentOcc <- readEvent $ fanParent f
750− return $ DMap.lookup k =<< parentOcc
752+ return . fmap runIdentity $ DMap.lookup k =<< parentOcc
751753 EventSwitch s -> do
752754 subscribed <- getSwitchSubscribed s
753755 liftIO $ do
@@ -794,7 +796,7 @@ subscribeEventSubscribed es ws = case es of
794796 modifyIORef' (pushSubscribedSubscribers subscribed) (ws:)
795797 EventSubscribedFan k subscribed -> do
796798 when debugSubscribe $ liftIO $ putStrLn $ "subscribeEventSubscribed Fan"
797− modifyIORef' (fanSubscribedSubscribers subscribed) $ DMap.insertWith (++) (FanSubscriberKey k) [ws]
799+ modifyIORef' (fanSubscribedSubscribers subscribed) $ DMap.insertWith (liftA2 (++)) (FanSubscriberKey k) (Identity [ws])
798800 EventSubscribedMerge subscribed -> do
799801 when debugSubscribe $ liftIO $ putStrLn $ "subscribeEventSubscribed Merge"
800802 modifyIORef' (mergeSubscribedSubscribers subscribed) (ws:)
@@ -812,7 +814,7 @@ getEventSubscribedOcc es = case es of
812814 EventSubscribedPush subscribed -> readIORef $ pushSubscribedOccurrence subscribed
813815 EventSubscribedFan k subscribed -> do
814816 parentOcc <- getEventSubscribedOcc $ fanSubscribedParent subscribed
815− let occ = DMap.lookup k =<< parentOcc
817+ let occ = fmap runIdentity $ DMap.lookup k =<< parentOcc
816818 return occ
817819 EventSubscribedMerge subscribed -> readIORef $ mergeSubscribedOccurrence subscribed
818820 EventSubscribedSwitch subscribed -> readIORef $ switchSubscribedOccurrence subscribed
@@ -841,18 +843,18 @@ noinlineFalse = False
841843getRootSubscribed :: GCompare k => k a -> Root k -> EventM (RootSubscribed a)
842844getRootSubscribed k r = do
843845 mSubscribed <- liftIO $ readIORef $ rootSubscribed r
844− case DMap.lookup (WrapArg k) mSubscribed of
846+ case DMap.lookup k mSubscribed of
845847 Just subscribed -> return subscribed
846848 Nothing -> liftIO $ do
847849 subscribersRef <- newIORef []
848− subscribed <- newRootSubscribed (liftM (DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef
850+ subscribed <- newRootSubscribed (liftM (fmap runIdentity . DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef
849851 -- Strangely, init needs the same stuff as a RootSubscribed has, but it must not be the same as the one that everyone's subscribing to, or it'll leak memory
850852 uninit <- rootInit r k $ RootTrigger (subscribersRef, rootOccurrence r, k)
851853 addFinalizer subscribed $ do
852854 when noinlineFalse $ putStr "" -- For some reason, without this line, the finalizer will run earlier than it should
853855-- putStrLn "Uninit root"
854856 uninit
855− liftIO $ modifyIORef' (rootSubscribed r) $ DMap.insert (WrapArg k) subscribed
857+ liftIO $ modifyIORef' (rootSubscribed r) $ DMap.insert k subscribed
856858 return subscribed
857859
858860-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
@@ -894,11 +896,11 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do
894896 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
895897 s <- liftIO $ newBox subscribedUnsafe
896898 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberMerge"
897− subscribers :: [(Any, Maybe (DSum k), Int, DSum (WrapArg EventSubscribed k))] <- forM (DMap.toList $ mergeParents m) $ {-# SCC "getMergeSubscribed.a" #-} \(WrapArg k :=> e) -> {-# SCC "getMergeSubscribed.a1" #-} do
899+ subscribers :: [(Any, Maybe (DSum k Identity), Int, DSum k EventSubscribed)] <- forM (DMap.toList $ mergeParents m) $ {-# SCC "getMergeSubscribed.a" #-} \(k :=> e) -> {-# SCC "getMergeSubscribed.a1" #-} do
898900 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws
899901 parentOcc <- {-# SCC "getMergeSubscribed.a.parentOcc" #-} liftIO $ getEventSubscribedOcc parentSubd
900902 height <- {-# SCC "getMergeSubscribed.a.height" #-} liftIO $ readIORef $ eventSubscribedHeightRef parentSubd
901− return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap (k :=>) parentOcc, height, WrapArg k :=> parentSubd)
903+ return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap ((k :=>) . Identity) parentOcc, height, k :=> parentSubd)
902904 let dm = DMap.fromDistinctAscList $ catMaybes $ map (\(_, x, _, _) -> x) subscribers
903905 subscriberHeights = map (\(_, _, x, _) -> x) subscribers
904906 myHeight =
@@ -1048,7 +1050,7 @@ getCoincidenceSubscribed c = do
10481050 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
10491051 return subscribed
10501052
1051−merge :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)
1053+merge :: GCompare k => DMap k Event -> Event (DMap k Identity)
10521054merge m = EventMerge $ Merge
10531055 { mergeParents = m
10541056 , mergeSubscribed = unsafeNewIORef m Nothing
@@ -1056,7 +1058,7 @@ merge m = EventMerge $ Merge
10561058
10571059newtype EventSelector k = EventSelector { select :: forall a. k a -> Event a }
10581060
1059−fan :: GCompare k => Event (DMap k) -> EventSelector k
1061+fan :: GCompare k => Event (DMap k Identity) -> EventSelector k
10601062fan e =
10611063 let f = Fan
10621064 { fanParent = e
@@ -1154,7 +1156,7 @@ invalidateSubscriberHeight ws = do
11541156 SubscriberFan subscribed -> do
11551157 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
11561158 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
1157− forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1159+ forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> Identity v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) Identity -> IO ())
11581160 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
11591161 SubscriberHold _ -> return ()
11601162 SubscriberSwitch subscribed -> do
@@ -1205,7 +1207,7 @@ recalculateSubscriberHeight ws = do
12051207 SubscriberFan subscribed -> do
12061208 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
12071209 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
1208− forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1210+ forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> Identity v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) Identity -> IO ())
12091211 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
12101212 SubscriberHold _ -> return ()
12111213 SubscriberSwitch subscribed -> do
@@ -1237,7 +1239,7 @@ recalculateCoincidenceHeight subscribed = do
12371239
12381240calculateMergeHeight :: MergeSubscribed k -> IO Int
12391241calculateMergeHeight subscribed = if DMap.null (mergeSubscribedParents subscribed) then return 0 else do
1240− heights <- forM (DMap.toList $ mergeSubscribedParents subscribed) $ \(WrapArg _ :=> es) -> do
1242+ heights <- forM (DMap.toList $ mergeSubscribedParents subscribed) $ \(_ :=> es) -> do
12411243 readIORef $ eventSubscribedHeightRef es
12421244 return $ if any (== invalidHeight) heights then invalidHeight else succ $ Prelude.maximum heights --TODO: Replace 'any' with invalidHeight-preserving 'maximum'
12431245
@@ -1316,7 +1318,7 @@ instance R.Reflex Spider where
13161318 constant = SpiderBehavior . BehaviorConst
13171319 push f = SpiderEvent. push f . unSpiderEvent
13181320 pull = SpiderBehavior . pull
1319− merge = SpiderEvent . merge . (unsafeCoerce :: DMap (WrapArg (R.Event Spider) k) -> DMap (WrapArg Event k))
1321+ merge = SpiderEvent . merge . (unsafeCoerce :: DMap k (R.Event Spider) -> DMap k Event)
13201322 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
13211323 switch = SpiderEvent . switch . (unsafeCoerce :: Behavior (R.Event Spider a) -> Behavior (Event a)) . unSpiderBehavior
13221324 coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event (R.Event Spider a) -> Event (Event a)) . unSpiderEvent
@@ -1340,7 +1342,7 @@ instance R.MonadHold Spider EventM where
13401342 {-# INLINE hold #-}
13411343 hold v0 e = SpiderBehavior <$> hold v0 (unSpiderEvent e)
13421344
1343−data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k), k a)
1345+data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k Identity), k a)
13441346newtype SpiderEventHandle a = SpiderEventHandle { unEventHandle :: Event a }
13451347
13461348instance R.MonadSubscribeEvent Spider SpiderHostFrame where
test/Reflex/Pure.hs+4−4
@@ -9,7 +9,7 @@ module Reflex.Pure where
99
1010import Reflex.Class
1111import Data.Functor.Misc
12−
12+import Control.Monad.Identity
1313import Control.Monad
1414import Data.MemoTrie
1515import Data.Dependent.Map (DMap, GCompare)
@@ -40,15 +40,15 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
4040 pull :: PullM (Pure t) a -> Behavior (Pure t) a
4141 pull = Behavior . memo
4242
43− merge :: GCompare k => DMap (WrapArg (Event (Pure t)) k) -> Event (Pure t) (DMap k)
43+ merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)
4444 merge events = Event $ memo $ \t ->
4545 let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
4646 in if DMap.null currentOccurrences
4747 then Nothing
4848 else Just currentOccurrences
4949
50− fan :: GCompare k => Event (Pure t) (DMap k) -> EventSelector (Pure t) k
51− fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
50+ fan :: GCompare k => Event (Pure t) (DMap k Identity) -> EventSelector (Pure t) k
51+ fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= fmap runIdentity . DMap.lookup k
5252
5353 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
5454 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
test/Reflex/Test/CrossImpl.hs+2−2
@@ -71,12 +71,12 @@ testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do
7171 let times = relevantTestingTimes (bMap, eMap)
7272 liftIO performGC
7373 outputs <- forM times $ \t -> do
74− forM_ (Map.lookup t bMap) $ \val -> mapM_ (\ rbt -> fireEvents [rbt :=> val]) =<< readRef rbTrigger
74+ forM_ (Map.lookup t bMap) $ \val -> mapM_ (\ rbt -> fireEvents [rbt :=> Identity val]) =<< readRef rbTrigger
7575 bOutput <- sample b'
7676 eOutput <- liftM join $ forM (Map.lookup t eMap) $ \val -> do
7777 mret <- readRef reTrigger
7878 let firing = case mret of
79− Just ret -> [ret :=> val]
79+ Just ret -> [ret :=> Identity val]
8080 Nothing -> []
8181 fireEventsAndRead firing $ sequence =<< readEvent e'Handle
8282 liftIO performGC