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