on develop help sign in
Allow subscribeEvent to be called from inside of HostFrame
commit1a4b582860f2ba08d2b248ef89b2aab01cc72446 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 25 Jul 2015, 17:26 (11 years ago) parentb107049
2 files changed+44−23
src/Reflex/Host/Class.hs+34−20 src/Reflex/Spider/Internal.hs+10−3
src/Reflex/Host/Class.hs+34−20
@@ -21,11 +21,25 @@ import Control.Monad.Ref
2121import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
2222
2323-- | Framework implementation support class for the reflex implementation represented by @t@.
24−class (Reflex t, MonadReflexCreateTrigger t (HostFrame t), MonadSample t (HostFrame t), MonadHold t (HostFrame t), MonadFix (HostFrame t)) => ReflexHost t where
24+class (Reflex t, MonadReflexCreateTrigger t (HostFrame t), MonadSample t (HostFrame t), MonadHold t (HostFrame t), MonadFix (HostFrame t), MonadSubscribeEvent t (HostFrame t)) => ReflexHost t where
2525 type EventTrigger t :: * -> *
2626 type EventHandle t :: * -> *
2727 type HostFrame t :: * -> *
2828
29+-- | Monad in which Events can be 'subscribed'. This forces all underlying event sources to be initialized, so that the event will fire whenever it ought to. Events must be subscribed before they are read using readEvent
30+class (Reflex t, Monad m) => MonadSubscribeEvent t m | m -> t where
31+ -- | Subscribe to an event and set it up if needed.
32+ --
33+ -- This function will create a new 'EventHandle' from an 'Event'. This handle may then be used via
34+ -- 'readEvent' in the read callback of 'fireEventsAndRead'.
35+ --
36+ -- If the event wasn't subscribed to before (either manually or through a dependent event or behavior)
37+ -- then this function will cause the event and all dependencies of this event to be set up.
38+ -- For example, if the event was created by 'newEventWithTrigger', then it's callback will be executed.
39+ --
40+ -- It's safe to call this function multiple times.
41+ subscribeEvent :: Event t a -> m (EventHandle t a)
42+
2943-- | Monad that allows to read events' values.
3044class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
3145 -- | Read the value of an 'Event' from an 'EventHandle' (created by calling 'subscribeEvent').
@@ -53,7 +67,7 @@ class (Applicative m, Monad m) => MonadReflexCreateTrigger t m | m -> t where
5367 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
5468 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
5569
56−class (ReflexHost t, MonadReflexCreateTrigger t m, MonadReadEvent t (ReadPhase m), MonadSample t (ReadPhase m), MonadHold t (ReadPhase m)) => MonadReflexHost t m | m -> t where
70+class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, MonadReadEvent t (ReadPhase m), MonadSample t (ReadPhase m), MonadHold t (ReadPhase m)) => MonadReflexHost t m | m -> t where
5771 type ReadPhase m :: * -> *
5872 -- | Propagate some events firings and read the values of events afterwards.
5973 --
@@ -70,18 +84,6 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadReadEvent t (ReadPhase m
7084 -- to read output events and perform a corresponding response action to the external event.
7185 fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a
7286
73− -- | Subscribe to an event and set it up if needed.
74− --
75− -- This function will create a new 'EventHandle' from an 'Event'. This handle may then be used via
76− -- 'readEvent' in the read callback of 'fireEventsAndRead'.
77− --
78− -- If the event wasn't subscribed to before (either manually or through a dependent event or behavior)
79− -- then this function will cause the event and all dependencies of this event to be set up.
80− -- For example, if the event was created by 'newEventWithTrigger', then it's callback will be executed.
81− --
82− -- It's safe to call this function multiple times.
83− subscribeEvent :: Event t a -> m (EventHandle t a)
84−
8587 -- | Run a frame without any events firing.
8688 --
8789 -- This function should be used when you want to use 'sample' and 'hold' when no events are currently firing.
@@ -119,58 +121,70 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ReaderT r m
119121 newEventWithTrigger = lift . newEventWithTrigger
120122 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
121123
124+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ReaderT r m) where
125+ subscribeEvent = lift . subscribeEvent
126+
122127instance MonadReflexHost t m => MonadReflexHost t (ReaderT r m) where
123128 type ReadPhase (ReaderT r m) = ReadPhase m
124129 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
125− subscribeEvent = lift . subscribeEvent
126130 runHostFrame = lift . runHostFrame
127131
128132instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (WriterT w m) where
129133 newEventWithTrigger = lift . newEventWithTrigger
130134 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
131135
136+instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (WriterT w m) where
137+ subscribeEvent = lift . subscribeEvent
138+
132139instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (WriterT w m) where
133140 type ReadPhase (WriterT w m) = ReadPhase m
134141 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
135− subscribeEvent = lift . subscribeEvent
136142 runHostFrame = lift . runHostFrame
137143
138144instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StateT s m) where
139145 newEventWithTrigger = lift . newEventWithTrigger
140146 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
141147
148+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (StateT r m) where
149+ subscribeEvent = lift . subscribeEvent
150+
142151instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where
143152 type ReadPhase (StateT s m) = ReadPhase m
144153 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
145− subscribeEvent = lift . subscribeEvent
146154 runHostFrame = lift . runHostFrame
147155
148156instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where
149157 newEventWithTrigger = lift . newEventWithTrigger
150158 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
151159
160+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ContT r m) where
161+ subscribeEvent = lift . subscribeEvent
162+
152163instance MonadReflexHost t m => MonadReflexHost t (ContT r m) where
153164 type ReadPhase (ContT r m) = ReadPhase m
154165 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
155− subscribeEvent = lift . subscribeEvent
156166 runHostFrame = lift . runHostFrame
157167
158168instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ExceptT e m) where
159169 newEventWithTrigger = lift . newEventWithTrigger
160170 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
161171
172+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ExceptT r m) where
173+ subscribeEvent = lift . subscribeEvent
174+
162175instance MonadReflexHost t m => MonadReflexHost t (ExceptT e m) where
163176 type ReadPhase (ExceptT e m) = ReadPhase m
164177 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
165− subscribeEvent = lift . subscribeEvent
166178 runHostFrame = lift . runHostFrame
167179
168180instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (RWST r w s m) where
169181 newEventWithTrigger = lift . newEventWithTrigger
170182 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
171183
184+instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (RWST r w s m) where
185+ subscribeEvent = lift . subscribeEvent
186+
172187instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (RWST r w s m) where
173188 type ReadPhase (RWST r w s m) = ReadPhase m
174189 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
175− subscribeEvent = lift . subscribeEvent
176190 runHostFrame = lift . runHostFrame
src/Reflex/Spider/Internal.hs+10−3
@@ -1343,6 +1343,11 @@ instance R.MonadHold Spider EventM where
13431343data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k), k a)
13441344newtype SpiderEventHandle a = SpiderEventHandle { unEventHandle :: Event a }
13451345
1346+instance R.MonadSubscribeEvent Spider SpiderHostFrame where
1347+ subscribeEvent e = SpiderHostFrame $ do
1348+ _ <- getEventSubscribed $ unSpiderEvent e --TODO: The result of this should actually be used
1349+ return $ SpiderEventHandle (unSpiderEvent e)
1350+
13461351instance R.ReflexHost Spider where
13471352 type EventTrigger Spider = RootTrigger
13481353 type EventHandle Spider = SpiderEventHandle
@@ -1404,14 +1409,16 @@ instance R.MonadReflexCreateTrigger Spider SpiderHostFrame where
14041409 es <- newFanEventWithTriggerIO f
14051410 return $ R.EventSelector $ SpiderEvent . select es
14061411
1412+instance R.MonadSubscribeEvent Spider SpiderHost where
1413+ subscribeEvent e = SpiderHost $ do
1414+ _ <- runFrame $ getEventSubscribed $ unSpiderEvent e --TODO: The result of this should actually be used
1415+ return $ SpiderEventHandle (unSpiderEvent e)
1416+
14071417newtype ReadPhase a = ReadPhase { runReadPhase :: ResultM a } deriving (Functor, Applicative, Monad, MonadFix, R.MonadSample Spider, R.MonadHold Spider)
14081418
14091419instance R.MonadReflexHost Spider SpiderHost where
14101420 type ReadPhase SpiderHost = ReadPhase
14111421 fireEventsAndRead es (ReadPhase a) = SpiderHost $ run es a
1412− subscribeEvent e = SpiderHost $ do
1413− _ <- runFrame $ getEventSubscribed $ unSpiderEvent e --TODO: The result of this should actually be used
1414− return $ SpiderEventHandle (unSpiderEvent e)
14151422 runHostFrame = SpiderHost . runFrame . runSpiderHostFrame
14161423
14171424instance MonadRef SpiderHost where