git.iko.soy/reflex
on 52ca995 help sign in
reflex/src/Reflex/Host/Class.hs
282 lines 13 kB history raw
1{-# LANGUAGE ExistentialQuantification #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RoleAnnotations #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE UndecidableInstances #-}
12-- | This module provides the interface for hosting 'Reflex' engines. This
13-- should only be necessary if you're writing a binding or some other library
14-- that provides a core event loop.
15module Reflex.Host.Class
16 ( ReflexHost (..)
17 , MonadSubscribeEvent (..)
18 , MonadReadEvent (..)
19 , MonadReflexCreateTrigger (..)
20 , MonadReflexHost (..)
21 , fireEvents
22 , newEventWithTriggerRef
23 , fireEventRef
24 , fireEventRefAndRead
25 ) where
27import Reflex.Class
29import Control.Applicative
30import Control.Monad
31import Control.Monad.Fix
32import Control.Monad.Identity
33import Control.Monad.Ref
34import Control.Monad.Trans
35import Control.Monad.Trans.Cont (ContT ())
36import Control.Monad.Trans.Except (ExceptT ())
37import Control.Monad.Trans.Reader (ReaderT ())
38import Control.Monad.Trans.RWS (RWST ())
39import Control.Monad.Trans.State (StateT ())
40import qualified Control.Monad.Trans.State.Strict as Strict
41import Control.Monad.Trans.Writer (WriterT ())
42import Data.Dependent.Sum (DSum (..))
43import Data.GADT.Compare
44import Data.Monoid
46-- Note: this import must come last to silence warnings from AMP
47import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
49-- | Framework implementation support class for the reflex implementation
50-- represented by @t@.
51class ( Reflex t
52 , MonadReflexCreateTrigger t (HostFrame t)
53 , MonadSample t (HostFrame t)
54 , MonadHold t (HostFrame t)
55 , MonadFix (HostFrame t)
56 , MonadSubscribeEvent t (HostFrame t)
57 ) => ReflexHost t where
58 type EventTrigger t :: * -> *
59 type EventHandle t :: * -> *
60 type HostFrame t :: * -> *
62-- | Monad in which Events can be 'subscribed'. This forces all underlying
63-- event sources to be initialized, so that the event will fire whenever it
64-- ought to. Events must be subscribed before they are read using readEvent
65class (Reflex t, Monad m) => MonadSubscribeEvent t m | m -> t where
66 -- | Subscribe to an event and set it up if needed.
67 --
68 -- This function will create a new 'EventHandle' from an 'Event'. This handle
69 -- may then be used via 'readEvent' in the read callback of
70 -- 'fireEventsAndRead'.
71 --
72 -- If the event wasn't subscribed to before (either manually or through a
73 -- dependent event or behavior) then this function will cause the event and
74 -- all dependencies of this event to be set up. For example, if the event was
75 -- created by 'newEventWithTrigger', then it's callback will be executed.
76 --
77 -- It's safe to call this function multiple times.
78 subscribeEvent :: Event t a -> m (EventHandle t a)
80-- | Monad that allows to read events' values.
81class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
82 -- | Read the value of an 'Event' from an 'EventHandle' (created by calling
83 -- 'subscribeEvent').
84 --
85 -- After event propagation is done, all events can be in two states: either
86 -- they are firing with some value or they are not firing. In the former
87 -- case, this function returns @Just act@, where @act@ in an action to read
88 -- the current value of the event. In the latter case, the function returns
89 -- @Nothing@.
90 --
91 -- This function is normally used in the calllback for 'fireEventsAndRead'.
92 readEvent :: EventHandle t a -> m (Maybe (m a))
94-- | A monad where new events feed from external sources can be created.
95class (Applicative m, Monad m) => MonadReflexCreateTrigger t m | m -> t where
96 -- | Creates a root 'Event' (one that is not based on any other event).
97 --
98 -- When a subscriber first subscribes to an event (building another event that
99 -- depends on the subscription) the given callback function is run and passed
100 -- a trigger. The callback function can then set up the event source in IO.
101 -- After this is done, the callback function must return an accompanying
102 -- teardown action.
103 --
104 -- Any time between setup and teardown the trigger can be used to fire the
105 -- event, by passing it to 'fireEventsAndRead'.
106 --
107 -- Note: An event may be set up multiple times. So after the teardown action
108 -- is executed, the event may still be set up again in the future.
109 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
110 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
112-- | 'MonadReflexHost' designates monads that can run reflex frames.
113class ( ReflexHost t
114 , MonadReflexCreateTrigger t m
115 , MonadSubscribeEvent t m
116 , MonadReadEvent t (ReadPhase m)
117 , MonadSample t (ReadPhase m)
118 , MonadHold t (ReadPhase m)
119 ) => MonadReflexHost t m | m -> t where
120 type ReadPhase m :: * -> *
121 -- | Propagate some events firings and read the values of events afterwards.
122 --
123 -- This function will create a new frame to fire the given events. It will
124 -- then update all dependent events and behaviors. After that is done, the
125 -- given callback is executed which allows to read the final values of events
126 -- and check whether they have fired in this frame or not.
127 --
128 -- All events that are given are fired at the same time.
129 --
130 -- This function is typically used in the main loop of a reflex framework
131 -- implementation. The main loop waits for external events to happen (such as
132 -- keyboard input or a mouse click) and then fires the corresponding events
133 -- using this function. The read callback can be used to read output events
134 -- and perform a corresponding response action to the external event.
135 fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
137 -- | Run a frame without any events firing.
138 --
139 -- This function should be used when you want to use 'sample' and 'hold' when
140 -- no events are currently firing. Using this function in that case can
141 -- improve performance, since the implementation can assume that no events are
142 -- firing when 'sample' or 'hold' are called.
143 --
144 -- This function is commonly used to set up the basic event network when the
145 -- application starts up.
146 runHostFrame :: HostFrame t a -> m a
148-- | Like 'fireEventsAndRead', but without reading any events.
149fireEvents :: MonadReflexHost t m => [DSum (EventTrigger t) Identity] -> m ()
150fireEvents dm = fireEventsAndRead dm $ return ()
151{-# INLINE fireEvents #-}
153-- | Create a new event and store its trigger in an 'IORef' while it's active.
154--
155-- An event is only active between the set up (when it's first subscribed to)
156-- and the teardown phases (when noboby is subscribing the event anymore). This
157-- function returns an Event and an 'IORef'. As long as the event is active, the
158-- 'IORef' will contain 'Just' the event trigger to trigger this event. When the
159-- event is not active, the 'IORef' will contain 'Nothing'. This allows event
160-- sources to be more efficient, since they don't need to produce events when
161-- nobody is listening.
162newEventWithTriggerRef :: (MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) => m (Event t a, Ref m (Maybe (EventTrigger t a)))
163newEventWithTriggerRef = do
164 rt <- newRef Nothing
165 e <- newEventWithTrigger $ \t -> do
166 writeRef rt $ Just t
167 return $ writeRef rt Nothing
168 return (e, rt)
169{-# INLINE newEventWithTriggerRef #-}
171-- | Fire the given trigger if it is not 'Nothing'.
172fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()
173fireEventRef mtRef input = do
174 mt <- readRef mtRef
175 case mt of
176 Nothing -> return ()
177 Just trigger -> fireEvents [trigger :=> Identity input]
179-- | Fire the given trigger if it is not 'Nothing', and read from the given
180-- 'EventHandle'.
181fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
182fireEventRefAndRead mtRef input e = do
183 mt <- readRef mtRef
184 case mt of
185 Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire
186 Just trigger -> fireEventsAndRead [trigger :=> Identity input] $ do
187 mGetValue <- readEvent e
188 case mGetValue of
189 Nothing -> return Nothing
190 Just getValue -> fmap Just getValue
193--------------------------------------------------------------------------------
194-- Instances
195--------------------------------------------------------------------------------
197instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ReaderT r m) where
198 newEventWithTrigger = lift . newEventWithTrigger
199 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
201instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ReaderT r m) where
202 subscribeEvent = lift . subscribeEvent
204instance MonadReflexHost t m => MonadReflexHost t (ReaderT r m) where
205 type ReadPhase (ReaderT r m) = ReadPhase m
206 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
207 runHostFrame = lift . runHostFrame
209instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (WriterT w m) where
210 newEventWithTrigger = lift . newEventWithTrigger
211 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
213instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (WriterT w m) where
214 subscribeEvent = lift . subscribeEvent
216instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (WriterT w m) where
217 type ReadPhase (WriterT w m) = ReadPhase m
218 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
219 runHostFrame = lift . runHostFrame
221instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StateT s m) where
222 newEventWithTrigger = lift . newEventWithTrigger
223 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
225instance MonadSubscribeEvent t m => MonadSubscribeEvent t (StateT r m) where
226 subscribeEvent = lift . subscribeEvent
228instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where
229 type ReadPhase (StateT s m) = ReadPhase m
230 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
231 runHostFrame = lift . runHostFrame
234instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (Strict.StateT s m) where
235 newEventWithTrigger = lift . newEventWithTrigger
236 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
238instance MonadSubscribeEvent t m => MonadSubscribeEvent t (Strict.StateT r m) where
239 subscribeEvent = lift . subscribeEvent
241instance MonadReflexHost t m => MonadReflexHost t (Strict.StateT s m) where
242 type ReadPhase (Strict.StateT s m) = ReadPhase m
243 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
244 runHostFrame = lift . runHostFrame
248instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where
249 newEventWithTrigger = lift . newEventWithTrigger
250 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
252instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ContT r m) where
253 subscribeEvent = lift . subscribeEvent
255instance MonadReflexHost t m => MonadReflexHost t (ContT r m) where
256 type ReadPhase (ContT r m) = ReadPhase m
257 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
258 runHostFrame = lift . runHostFrame
260instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ExceptT e m) where
261 newEventWithTrigger = lift . newEventWithTrigger
262 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
264instance MonadSubscribeEvent t m => MonadSubscribeEvent t (ExceptT r m) where
265 subscribeEvent = lift . subscribeEvent
267instance MonadReflexHost t m => MonadReflexHost t (ExceptT e m) where
268 type ReadPhase (ExceptT e m) = ReadPhase m
269 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
270 runHostFrame = lift . runHostFrame
272instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t (RWST r w s m) where
273 newEventWithTrigger = lift . newEventWithTrigger
274 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
276instance (MonadSubscribeEvent t m, Monoid w) => MonadSubscribeEvent t (RWST r w s m) where
277 subscribeEvent = lift . subscribeEvent
279instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (RWST r w s m) where
280 type ReadPhase (RWST r w s m) = ReadPhase m
281 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
282 runHostFrame = lift . runHostFrame