git.iko.soy/patch
on c6e599b help sign in
patch/src/Reflex/PerformEvent/Class.hs
64 lines 2.7 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 MultiParamTypeClasses #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE UndecidableInstances #-}
14#ifdef USE_REFLEX_OPTIMIZER
15{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
16#endif
17module Reflex.PerformEvent.Class
18 ( PerformEvent (..)
19 , performEventAsync
20 ) where
22import Reflex.Class
23import Reflex.TriggerEvent.Class
25import Control.Monad.Reader
27-- | 'PerformEvent' represents actions that can trigger other actions based on
28-- 'Event's.
29class (Reflex t, Monad (Performable m), Monad m) => PerformEvent t m | m -> t where
30 -- | The type of action to be triggered; this is often not the same type as
31 -- the triggering action.
32 type Performable m :: * -> *
33 -- | Perform the action contained in the given 'Event' whenever the 'Event'
34 -- fires. Return the result in another 'Event'. Note that the output 'Event'
35 -- will generally occur later than the input 'Event', since most 'Performable'
36 -- actions cannot be performed during 'Event' propagation.
37 performEvent :: Event t (Performable m a) -> m (Event t a)
38 -- | Like 'performEvent', but do not return the result. May have slightly
39 -- better performance.
40 performEvent_ :: Event t (Performable m ()) -> m ()
42-- | Like 'performEvent', but the resulting 'Event' occurs only when the
43-- callback (@a -> IO ()@) is called, not when the included action finishes.
44--
45-- NOTE: Despite the name, 'performEventAsync' does not run its action in a
46-- separate thread - although the action is free to invoke forkIO and then call
47-- the callback whenever it is ready. This will work properly, even in GHCJS
48-- (which fully implements concurrency even though JavaScript does not have
49-- built in concurrency).
50{-# INLINABLE performEventAsync #-}
51performEventAsync :: (TriggerEvent t m, PerformEvent t m) => Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
52performEventAsync e = do
53 (eOut, triggerEOut) <- newTriggerEvent
54 performEvent_ $ fmap ($ triggerEOut) e
55 return eOut
57instance PerformEvent t m => PerformEvent t (ReaderT r m) where
58 type Performable (ReaderT r m) = ReaderT r (Performable m)
59 performEvent_ e = do
60 r <- ask
61 lift $ performEvent_ $ flip runReaderT r <$> e
62 performEvent e = do
63 r <- ask
64 lift $ performEvent $ flip runReaderT r <$> e