git.iko.soy/reflex
on develop help sign in
Added `ReflexBase` as a base monad for Reflex programs
62b68b4Will Fancher
reflex.cabal+1
compare with develop
unifiedsplit
@@ -57,6 +57,7 @@ library
57 Data.Functor.Misc,
57 Data.Functor.Misc,
58 Data.WeakBag,
58 Data.WeakBag,
59 Reflex,
59 Reflex,
60+ Reflex.Base,
60 Reflex.Class,
61 Reflex.Class,
61 Reflex.Dynamic,
62 Reflex.Dynamic,
62 Reflex.Dynamic.TH,
63 Reflex.Dynamic.TH,
src/Reflex.hs+1
@@ -2,6 +2,7 @@
2-- you are just getting started with Reflex, this is probably what you want.
2-- you are just getting started with Reflex, this is probably what you want.
3module Reflex (module X) where
3module Reflex (module X) where
4
4
5+import Reflex.Base as X
5import Reflex.Class as X
6import Reflex.Class as X
6import Reflex.Dynamic as X
7import Reflex.Dynamic as X
7import Reflex.Dynamic.TH as X
8import Reflex.Dynamic.TH as X
src/Reflex/Base.hsnew file+70
@@ -0,0 +1,70 @@
1+module Reflex.Base where
2+
3+import Control.Concurrent
4+import Control.Monad
5+import Control.Monad.IO.Class
6+import Control.Monad.Ref
7+import Data.Dependent.Sum
8+import Data.Foldable
9+import Data.Functor.Identity
10+import Data.Maybe
11+import Data.Traversable
12+
13+import Reflex.Host.Class
14+import Reflex.PerformEvent.Base
15+import Reflex.PostBuild.Class
16+import Reflex.Spider.Internal
17+import Reflex.TriggerEvent.Base
18+
19+type ReflexBase x = PostBuildT (SpiderTimeline x) (TriggerEventT (SpiderTimeline x) (PerformEventT (SpiderTimeline x) (SpiderHost x)))
20+
21+-- | Runs a program in a given timeline. Returns the result of the
22+-- program, a firing command for firing events in the program, and the
23+-- thread id for the event firing thread.
24+runReflexBaseForTimeline'
25+ :: HasSpiderTimeline x
26+ => ReflexBase x a
27+ -> SpiderTimelineEnv x
28+ -> IO (a, FireCommand (SpiderTimeline x) (SpiderHost x), ThreadId)
29+runReflexBaseForTimeline' basic t = do
30+ events <- newChan
31+ (result, FireCommand fire) <-
32+ flip runSpiderHostForTimeline t $ do
33+ (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
34+ -- Run the various layers of event logic that exist over 'SpiderHost'
35+ results@(_, FireCommand fire) <-
36+ hostPerformEventT
37+ (runTriggerEventT (runPostBuildT basic postBuild) events)
38+ -- Read the trigger's ref, traverse into its 'Maybe', and fire the event
39+ readRef postBuildTriggerRef >>=
40+ traverse_
41+ (\postBuildTrigger ->
42+ fire [postBuildTrigger :=> Identity ()] $ return ())
43+ return results
44+ -- Start a thread that fires events forever
45+ eventThreadId <-
46+ forkIO . forever $ do
47+ triggers <- readChan events
48+ void . flip runSpiderHostForTimeline t $ do
49+ triggersToFire <-
50+ liftIO . for triggers $ \(EventTriggerRef tref :=> TriggerInvocation a _) ->
51+ fmap (\trigger -> trigger :=> Identity a) <$> readRef tref
52+ void . fire (catMaybes triggersToFire) $ return ()
53+ liftIO . for_ triggers $ \(_ :=> TriggerInvocation _ cb) -> cb
54+ return ()
55+ return (result, FireCommand fire, eventThreadId)
56+
57+-- | Like 'runReflexBasic'', but discards the less relevant outputs.
58+runReflexBaseForTimeline
59+ :: HasSpiderTimeline x
60+ => ReflexBase x a -> SpiderTimelineEnv x -> IO a
61+runReflexBaseForTimeline basic =
62+ fmap (\(a, _, _) -> a) . runReflexBaseForTimeline' basic
63+
64+runReflexBase'
65+ :: ReflexBase Global a
66+ -> IO (a, FireCommand (SpiderTimeline Global) (SpiderHost Global), ThreadId)
67+runReflexBase' basic = runReflexBaseForTimeline' basic globalSpiderTimelineEnv
68+
69+runReflexBase :: ReflexBase Global a -> IO a
70+runReflexBase basic = runReflexBaseForTimeline basic globalSpiderTimelineEnv