on ae@dev-script help sign in
63 lines 2.6 kB history raw
1-- | This module defines 'PerformEvent' and 'TriggerEvent', which mediate the
2-- interaction between a "Reflex"-based program and the external side-effecting
3-- actions such as 'IO'.
4{-# LANGUAGE CPP #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
8{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeOperators #-}
12{-# LANGUAGE UndecidableInstances #-}
13#ifdef USE_REFLEX_OPTIMIZER
14{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
15#endif
16module Reflex.PerformEvent.Class
17 ( PerformEvent (..)
18 , performEventAsync
19 ) where
21import Reflex.Class
22import Reflex.TriggerEvent.Class
24import Control.Monad.Reader
26-- | 'PerformEvent' represents actions that can trigger other actions based on
27-- 'Event's.
28class (Reflex t, Monad (Performable m), Monad m) => PerformEvent t m | m -> t where
29 -- | The type of action to be triggered; this is often not the same type as
30 -- the triggering action.
31 type Performable m :: * -> *
32 -- | Perform the action contained in the given 'Event' whenever the 'Event'
33 -- fires. Return the result in another 'Event'. Note that the output 'Event'
34 -- will generally occur later than the input 'Event', since most 'Performable'
35 -- actions cannot be performed during 'Event' propagation.
36 performEvent :: Event t (Performable m a) -> m (Event t a)
37 -- | Like 'performEvent', but do not return the result. May have slightly
38 -- better performance.
39 performEvent_ :: Event t (Performable m ()) -> m ()
41-- | Like 'performEvent', but the resulting 'Event' occurs only when the
42-- callback (@a -> IO ()@) is called, not when the included action finishes.
43--
44-- NOTE: Despite the name, 'performEventAsync' does not run its action in a
45-- separate thread - although the action is free to invoke forkIO and then call
46-- the callback whenever it is ready. This will work properly, even in GHCJS
47-- (which fully implements concurrency even though JavaScript does not have
48-- built in concurrency).
49{-# INLINABLE performEventAsync #-}
50performEventAsync :: (TriggerEvent t m, PerformEvent t m) => Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
51performEventAsync e = do
52 (eOut, triggerEOut) <- newTriggerEvent
53 performEvent_ $ fmap ($ triggerEOut) e
54 return eOut
56instance PerformEvent t m => PerformEvent t (ReaderT r m) where
57 type Performable (ReaderT r m) = ReaderT r (Performable m)
58 performEvent_ e = do
59 r <- ask
60 lift $ performEvent_ $ flip runReaderT r <$> e
61 performEvent e = do
62 r <- ask
63 lift $ performEvent $ flip runReaderT r <$> e