git.iko.soy/reflex
on develop help sign in
Allow subscribeEvent to be called from inside of HostFrame
1a4b582Ryan Trinkle
src/Reflex/Host/Class.hs+34−20
compare with develop
unifiedsplit
@@ -21,11 +21,25 @@ import Control.Monad.Ref
21import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
21import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
22
22
23-- | Framework implementation support class for the reflex implementation represented by @t@.
23-- | 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
25 type EventTrigger t :: * -> *
25 type EventTrigger t :: * -> *
26 type EventHandle t :: * -> *
26 type EventHandle t :: * -> *
27 type HostFrame t :: * -> *
27 type HostFrame t :: * -> *
28
28
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+
29-- | Monad that allows to read events' values.
43-- | Monad that allows to read events' values.
30class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
44class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
31 -- | Read the value of an 'Event' from an 'EventHandle' (created by calling 'subscribeEvent').
45 -- | 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
53 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
67 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
54 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
68 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
55
69
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
57 type ReadPhase m :: * -> *
71 type ReadPhase m :: * -> *
58 -- | Propagate some events firings and read the values of events afterwards.
72 -- | Propagate some events firings and read the values of events afterwards.
59 --
73 --
@@ -70,18 +84,6 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadReadEvent t (ReadPhase m
70 -- to read output events and perform a corresponding response action to the external event.
84 -- to read output events and perform a corresponding response action to the external event.
71 fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a
85 fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a
72
86
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−
85 -- | Run a frame without any events firing.
87 -- | Run a frame without any events firing.
86 --
88 --
87 -- This function should be used when you want to use 'sample' and 'hold' when no events are currently firing.
89 -- 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
119 newEventWithTrigger = lift . newEventWithTrigger
121 newEventWithTrigger = lift . newEventWithTrigger
120 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
122 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
121
123
124+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ReaderT r m) where
125+ subscribeEvent = lift . subscribeEvent
126+
122instance MonadReflexHost t m => MonadReflexHost t (ReaderT r m) where
127instance MonadReflexHost t m => MonadReflexHost t (ReaderT r m) where
123 type ReadPhase (ReaderT r m) = ReadPhase m
128 type ReadPhase (ReaderT r m) = ReadPhase m
124 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
129 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
125− subscribeEvent = lift . subscribeEvent
126 runHostFrame = lift . runHostFrame
130 runHostFrame = lift . runHostFrame
127
131
128instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (WriterT w m) where
132instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (WriterT w m) where
129 newEventWithTrigger = lift . newEventWithTrigger
133 newEventWithTrigger = lift . newEventWithTrigger
130 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
134 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
131
135
136+instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (WriterT w m) where
137+ subscribeEvent = lift . subscribeEvent
138+
132instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (WriterT w m) where
139instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (WriterT w m) where
133 type ReadPhase (WriterT w m) = ReadPhase m
140 type ReadPhase (WriterT w m) = ReadPhase m
134 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
141 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
135− subscribeEvent = lift . subscribeEvent
136 runHostFrame = lift . runHostFrame
142 runHostFrame = lift . runHostFrame
137
143
138instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StateT s m) where
144instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StateT s m) where
139 newEventWithTrigger = lift . newEventWithTrigger
145 newEventWithTrigger = lift . newEventWithTrigger
140 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
146 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
141
147
148+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (StateT r m) where
149+ subscribeEvent = lift . subscribeEvent
150+
142instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where
151instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where
143 type ReadPhase (StateT s m) = ReadPhase m
152 type ReadPhase (StateT s m) = ReadPhase m
144 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
153 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
145− subscribeEvent = lift . subscribeEvent
146 runHostFrame = lift . runHostFrame
154 runHostFrame = lift . runHostFrame
147
155
148instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where
156instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where
149 newEventWithTrigger = lift . newEventWithTrigger
157 newEventWithTrigger = lift . newEventWithTrigger
150 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
158 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
151
159
160+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ContT r m) where
161+ subscribeEvent = lift . subscribeEvent
162+
152instance MonadReflexHost t m => MonadReflexHost t (ContT r m) where
163instance MonadReflexHost t m => MonadReflexHost t (ContT r m) where
153 type ReadPhase (ContT r m) = ReadPhase m
164 type ReadPhase (ContT r m) = ReadPhase m
154 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
165 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
155− subscribeEvent = lift . subscribeEvent
156 runHostFrame = lift . runHostFrame
166 runHostFrame = lift . runHostFrame
157
167
158instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ExceptT e m) where
168instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ExceptT e m) where
159 newEventWithTrigger = lift . newEventWithTrigger
169 newEventWithTrigger = lift . newEventWithTrigger
160 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
170 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
161
171
172+instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ExceptT r m) where
173+ subscribeEvent = lift . subscribeEvent
174+
162instance MonadReflexHost t m => MonadReflexHost t (ExceptT e m) where
175instance MonadReflexHost t m => MonadReflexHost t (ExceptT e m) where
163 type ReadPhase (ExceptT e m) = ReadPhase m
176 type ReadPhase (ExceptT e m) = ReadPhase m
164 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
177 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
165− subscribeEvent = lift . subscribeEvent
166 runHostFrame = lift . runHostFrame
178 runHostFrame = lift . runHostFrame
167
179
168instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (RWST r w s m) where
180instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (RWST r w s m) where
169 newEventWithTrigger = lift . newEventWithTrigger
181 newEventWithTrigger = lift . newEventWithTrigger
170 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
182 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
171
183
184+instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (RWST r w s m) where
185+ subscribeEvent = lift . subscribeEvent
186+
172instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (RWST r w s m) where
187instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (RWST r w s m) where
173 type ReadPhase (RWST r w s m) = ReadPhase m
188 type ReadPhase (RWST r w s m) = ReadPhase m
174 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
189 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
175− subscribeEvent = lift . subscribeEvent
176 runHostFrame = lift . runHostFrame
190 runHostFrame = lift . runHostFrame
src/Reflex/Spider/Internal.hs+10−3
@@ -1343,6 +1343,11 @@ instance R.MonadHold Spider EventM where
1343data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k), k a)
1343data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k), k a)
1344newtype SpiderEventHandle a = SpiderEventHandle { unEventHandle :: Event a }
1344newtype SpiderEventHandle a = SpiderEventHandle { unEventHandle :: Event a }
1345
1345
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+
1346instance R.ReflexHost Spider where
1351instance R.ReflexHost Spider where
1347 type EventTrigger Spider = RootTrigger
1352 type EventTrigger Spider = RootTrigger
1348 type EventHandle Spider = SpiderEventHandle
1353 type EventHandle Spider = SpiderEventHandle
@@ -1404,14 +1409,16 @@ instance R.MonadReflexCreateTrigger Spider SpiderHostFrame where
1404 es <- newFanEventWithTriggerIO f
1409 es <- newFanEventWithTriggerIO f
1405 return $ R.EventSelector $ SpiderEvent . select es
1410 return $ R.EventSelector $ SpiderEvent . select es
1406
1411
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+
1407newtype ReadPhase a = ReadPhase { runReadPhase :: ResultM a } deriving (Functor, Applicative, Monad, MonadFix, R.MonadSample Spider, R.MonadHold Spider)
1417newtype ReadPhase a = ReadPhase { runReadPhase :: ResultM a } deriving (Functor, Applicative, Monad, MonadFix, R.MonadSample Spider, R.MonadHold Spider)
1408
1418
1409instance R.MonadReflexHost Spider SpiderHost where
1419instance R.MonadReflexHost Spider SpiderHost where
1410 type ReadPhase SpiderHost = ReadPhase
1420 type ReadPhase SpiderHost = ReadPhase
1411 fireEventsAndRead es (ReadPhase a) = SpiderHost $ run es a
1421 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)
1415 runHostFrame = SpiderHost . runFrame . runSpiderHostFrame
1422 runHostFrame = SpiderHost . runFrame . runSpiderHostFrame
1416
1423
1417instance MonadRef SpiderHost where
1424instance MonadRef SpiderHost where