on develop help sign in
Eliminate ReaderT in SpiderHost
commit62ad2e3a9cfd2a2459a4b618c5a027e14bae7fe3 authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 11 Oct 2018, 17:23 (8 years ago) parent24cc530
1 file changed+9−9
src/Reflex/Spider/Internal.hs+9−9
src/Reflex/Spider/Internal.hs+9−9
@@ -1217,8 +1217,8 @@ coincidence a = eventCoincidence $ Coincidence
12171217run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
12181218run roots after = do
12191219 tracePropagate (Proxy :: Proxy x) $ "Running an event frame with " <> show (length roots) <> " events"
1220− t <- SpiderHost ask
1221− result <- SpiderHost $ lift $ withMVar (_spiderTimeline_lock t) $ \_ -> flip runReaderT t $ unSpiderHost $ runFrame $ do
1220+ let t = spiderTimeline :: SpiderTimelineEnv x
1221+ result <- SpiderHost $ withMVar (_spiderTimeline_lock t) $ \_ -> unSpiderHost $ runFrame $ do
12221222 rootsToPropagate <- forM roots $ \r@(RootTrigger (_, occRef, k) :=> a) -> do
12231223 occBefore <- liftIO $ do
12241224 occBefore <- readIORef occRef
@@ -2085,7 +2085,7 @@ clearEventEnv (EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeI
20852085
20862086-- | Run an event action outside of a frame
20872087runFrame :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex
2088−runFrame a = SpiderHost $ ask >>= \_ -> lift $ do
2088+runFrame a = SpiderHost $ do
20892089 let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)
20902090 let go = do
20912091 result <- a
@@ -2126,7 +2126,7 @@ runFrame a = SpiderHost $ ask >>= \_ -> lift $ do
21262126 runEventM $ runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant
21272127 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times
21282128 sub <- newSubscriberSwitch subscribed
2129− subscription <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderTimeline --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
2129+ subscription <- unSpiderHost $ runFrame $ {-# SCC "subscribeSwitch" #-} subscribe e sub --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
21302130 {-
21312131 stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)
21322132 liftIO $ putStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of
@@ -2416,8 +2416,8 @@ instance HasSpiderTimeline x => Reflex.Host.Class.MonadReadEvent (SpiderTimeline
24162416 return result
24172417
24182418instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
2419− newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO
2420− newFanEventWithTrigger f = SpiderHost $ lift $ do
2419+ newEventWithTrigger = SpiderHost . fmap SpiderEvent . newEventWithTriggerIO
2420+ newFanEventWithTrigger f = SpiderHost $ do
24212421 es <- newFanEventWithTriggerIO f
24222422 return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es
24232423
@@ -2554,7 +2554,7 @@ instance MonadAtomicRef (EventM x) where
25542554 atomicModifyRef r f = liftIO $ atomicModifyRef r f
25552555
25562556-- | The monad for actions that manipulate a Spider timeline identified by @x@
2557−newtype SpiderHost x a = SpiderHost { unSpiderHost :: ReaderT (SpiderTimelineEnv x) IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
2557+newtype SpiderHost x a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
25582558
25592559instance Monad (SpiderHost x) where
25602560 {-# INLINABLE (>>=) #-}
@@ -2569,12 +2569,12 @@ instance Monad (SpiderHost x) where
25692569-- | Run an action affecting the global Spider timeline; this will be guarded by
25702570-- a mutex for that timeline
25712571runSpiderHost :: SpiderHost Global a -> IO a
2572−runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimelineEnv
2572+runSpiderHost (SpiderHost a) = a
25732573
25742574-- | Run an action affecting a given Spider timeline; this will be guarded by a
25752575-- mutex for that timeline
25762576runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a
2577−runSpiderHostForTimeline (SpiderHost a) = runReaderT a
2577+runSpiderHostForTimeline (SpiderHost a) _ = a
25782578
25792579newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }
25802580 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)