git.iko.soy/patch
on develop help sign in
Add docs; fix style
8de0159Ryan Trinkle
src/Reflex/TriggerEvent/Base.hs+45−47
compare with develop
unifiedsplit
@@ -1,10 +1,17 @@
1+-- | This module defines 'TriggerEventT', the standard implementation of
2+-- 'TriggerEvent'.
1{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
6−
7−module Reflex.TriggerEvent.Base where
8+module Reflex.TriggerEvent.Base
9+ ( TriggerEventT (..)
10+ , runTriggerEventT
11+ , askEvents
12+ , TriggerInvocation (..)
13+ , EventTriggerRef (..)
14+ ) where
8
15
9import Control.Concurrent
16import Control.Concurrent
10import Control.Monad.Exception
17import Control.Monad.Exception
@@ -17,97 +24,88 @@ import Reflex.PerformEvent.Class
17import Reflex.PostBuild.Class
24import Reflex.PostBuild.Class
18import Reflex.TriggerEvent.Class
25import Reflex.TriggerEvent.Class
19
26
27+-- | A value with which to fire an 'Event', as well as a callback to invoke
28+-- after its propagation has completed.
20data TriggerInvocation a = TriggerInvocation a (IO ())
29data TriggerInvocation a = TriggerInvocation a (IO ())
21
30
31+-- | A reference to an 'EventTrigger' suitable for firing with 'TriggerEventT'.
22newtype EventTriggerRef t m a = EventTriggerRef { unEventTriggerRef :: Ref m (Maybe (EventTrigger t a)) }
32newtype EventTriggerRef t m a = EventTriggerRef { unEventTriggerRef :: Ref m (Maybe (EventTrigger t a)) }
23
33
24−newtype TriggerEventT t m a = TriggerEventT
34+-- | A basic implementation of 'TriggerEvent'.
25− { unTriggerEventT :: ReaderT (Chan [DSum (EventTriggerRef t m) TriggerInvocation]) m a
35+newtype TriggerEventT t m a = TriggerEventT { unTriggerEventT :: ReaderT (Chan [DSum (EventTriggerRef t m) TriggerInvocation]) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
26− } deriving ( Functor
27− , Applicative
28− , Monad
29− , MonadFix
30− , MonadIO
31− , MonadException
32− , MonadAsyncException
33− )
34
36
37+-- | Run a 'TriggerEventT' action. The argument should be a 'Chan' into which
38+-- 'TriggerInvocation's can be passed; it is expected that some other thread
39+-- will be responsible for popping values out of the 'Chan' and firing their
40+-- 'EventTrigger's.
35runTriggerEventT :: TriggerEventT t m a -> Chan [DSum (EventTriggerRef t m) TriggerInvocation] -> m a
41runTriggerEventT :: TriggerEventT t m a -> Chan [DSum (EventTriggerRef t m) TriggerInvocation] -> m a
36runTriggerEventT = runReaderT . unTriggerEventT
42runTriggerEventT = runReaderT . unTriggerEventT
37
43
38instance MonadTrans (TriggerEventT t) where
44instance MonadTrans (TriggerEventT t) where
39 lift = TriggerEventT . lift
45 lift = TriggerEventT . lift
40
46
41−instance PerformEvent t m =>
42− PerformEvent t (TriggerEventT t m) where
47+instance PerformEvent t m => PerformEvent t (TriggerEventT t m) where
43 type Performable (TriggerEventT t m) = Performable m
48 type Performable (TriggerEventT t m) = Performable m
44− performEvent_ e = lift $ performEvent_ e
45 {-# INLINABLE performEvent_ #-}
49 {-# INLINABLE performEvent_ #-}
46− performEvent e = lift $ performEvent e
50+ performEvent_ e = lift $ performEvent_ e
47 {-# INLINABLE performEvent #-}
51 {-# INLINABLE performEvent #-}
52+ performEvent e = lift $ performEvent e
48
53
49−instance PostBuild t m =>
50− PostBuild t (TriggerEventT t m) where
54+instance PostBuild t m => PostBuild t (TriggerEventT t m) where
51− getPostBuild = lift getPostBuild
52 {-# INLINABLE getPostBuild #-}
55 {-# INLINABLE getPostBuild #-}
56+ getPostBuild = lift getPostBuild
53
57
54−instance MonadReflexCreateTrigger t m =>
55− MonadReflexCreateTrigger t (TriggerEventT t m) where
58+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (TriggerEventT t m) where
56− newEventWithTrigger = lift . newEventWithTrigger
57 {-# INLINABLE newEventWithTrigger #-}
59 {-# INLINABLE newEventWithTrigger #-}
58− newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
60+ newEventWithTrigger = lift . newEventWithTrigger
59 {-# INLINABLE newFanEventWithTrigger #-}
61 {-# INLINABLE newFanEventWithTrigger #-}
62+ newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
60
63
61−instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) =>
64+instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (TriggerEventT t m) where
62− TriggerEvent t (TriggerEventT t m) where
65+ {-# INLINABLE newTriggerEvent #-}
63 newTriggerEvent = do
66 newTriggerEvent = do
64 (e, t) <- newTriggerEventWithOnComplete
67 (e, t) <- newTriggerEventWithOnComplete
65 return (e, \a -> t a $ return ())
68 return (e, \a -> t a $ return ())
66− {-# INLINABLE newTriggerEvent #-}
69+ {-# INLINABLE newTriggerEventWithOnComplete #-}
67 newTriggerEventWithOnComplete = do
70 newTriggerEventWithOnComplete = do
68 events <- askEvents
71 events <- askEvents
69 (eResult, reResultTrigger) <- lift newEventWithTriggerRef
72 (eResult, reResultTrigger) <- lift newEventWithTriggerRef
70 return . (,) eResult $ \a cb ->
73 return . (,) eResult $ \a cb ->
71 writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]
74 writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]
72− {-# INLINABLE newTriggerEventWithOnComplete #-}
75+ {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
73 newEventWithLazyTriggerWithOnComplete f = do
76 newEventWithLazyTriggerWithOnComplete f = do
74 events <- askEvents
77 events <- askEvents
75 lift . newEventWithTrigger $ \t ->
78 lift . newEventWithTrigger $ \t ->
76 f $ \a cb -> do
79 f $ \a cb -> do
77 reResultTrigger <- newRef $ Just t
80 reResultTrigger <- newRef $ Just t
78 writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]
81 writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]
79− {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
80
82
81−instance MonadRef m =>
82− MonadRef (TriggerEventT t m) where
83+instance MonadRef m => MonadRef (TriggerEventT t m) where
83 type Ref (TriggerEventT t m) = Ref m
84 type Ref (TriggerEventT t m) = Ref m
84− newRef = lift . newRef
85 {-# INLINABLE newRef #-}
85 {-# INLINABLE newRef #-}
86− readRef = lift . readRef
86+ newRef = lift . newRef
87 {-# INLINABLE readRef #-}
87 {-# INLINABLE readRef #-}
88− writeRef r = lift . writeRef r
88+ readRef = lift . readRef
89 {-# INLINABLE writeRef #-}
89 {-# INLINABLE writeRef #-}
90+ writeRef r = lift . writeRef r
90
91
91−instance MonadAtomicRef m =>
92− MonadAtomicRef (TriggerEventT t m) where
92+instance MonadAtomicRef m => MonadAtomicRef (TriggerEventT t m) where
93− atomicModifyRef r = lift . atomicModifyRef r
94 {-# INLINABLE atomicModifyRef #-}
93 {-# INLINABLE atomicModifyRef #-}
94+ atomicModifyRef r = lift . atomicModifyRef r
95
95
96−instance MonadSample t m =>
97− MonadSample t (TriggerEventT t m) where
96+instance MonadSample t m => MonadSample t (TriggerEventT t m) where
98− sample = lift . sample
99 {-# INLINABLE sample #-}
97 {-# INLINABLE sample #-}
98+ sample = lift . sample
100
99
101−instance MonadHold t m =>
102− MonadHold t (TriggerEventT t m) where
100+instance MonadHold t m => MonadHold t (TriggerEventT t m) where
103− hold v0 v' = lift $ hold v0 v'
104 {-# INLINABLE hold #-}
101 {-# INLINABLE hold #-}
105− holdDyn v0 v' = lift $ holdDyn v0 v'
102+ hold v0 v' = lift $ hold v0 v'
106 {-# INLINABLE holdDyn #-}
103 {-# INLINABLE holdDyn #-}
107− holdIncremental v0 v' = lift $ holdIncremental v0 v'
104+ holdDyn v0 v' = lift $ holdDyn v0 v'
108 {-# INLINABLE holdIncremental #-}
105 {-# INLINABLE holdIncremental #-}
106+ holdIncremental v0 v' = lift $ holdIncremental v0 v'
109
107
110−askEvents
108+-- | Retrieve the current 'Chan'; event trigger invocations pushed into it will
111− :: Monad m
109+-- be fired.
112− => TriggerEventT t m (Chan [DSum (EventTriggerRef t m) TriggerInvocation])
110+askEvents :: Monad m => TriggerEventT t m (Chan [DSum (EventTriggerRef t m) TriggerInvocation])
113askEvents = TriggerEventT ask
111askEvents = TriggerEventT ask
src/Reflex/TriggerEvent/Class.hs+3−2
@@ -1,8 +1,9 @@
1+-- | This module defines 'TriggerEvent', which describes actions that may create
2+-- new 'Event's that can be triggered from 'IO'.
1{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE FunctionalDependencies #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE UndecidableInstances #-}
5−
6module Reflex.TriggerEvent.Class
7module Reflex.TriggerEvent.Class
7 ( TriggerEvent (..)
8 ( TriggerEvent (..)
8 ) where
9 ) where
@@ -13,7 +14,7 @@ import Control.Monad.Reader
13
14
14--TODO: Shouldn't have IO hard-coded
15--TODO: Shouldn't have IO hard-coded
15-- | 'TriggerEvent' represents actions that can create 'Event's that can be
16-- | 'TriggerEvent' represents actions that can create 'Event's that can be
16−-- triggered from the IO monad.
17+-- triggered by 'IO' actions.
17class Monad m => TriggerEvent t m | m -> t where
18class Monad m => TriggerEvent t m | m -> t where
18 -- | Create a triggerable 'Event'. Whenever the resulting function is called,
19 -- | Create a triggerable 'Event'. Whenever the resulting function is called,
19 -- the resulting 'Event' will fire at some point in the future. Note that
20 -- the resulting 'Event' will fire at some point in the future. Note that