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