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