@@ -6,36 +6,38 @@
7module Reflex.Host.Headless where
7module Reflex.Host.Headless where
9+import Control.Concurrent.Chan (newChan, readChan)
10+import Control.Monad.Fix (MonadFix, fix)
11+import Control.Monad.IO.Class (MonadIO, liftIO)
12+import Control.Monad.Primitive (PrimMonad)
13+import Control.Monad.Ref (MonadRef, Ref, readRef)
14+import Data.Dependent.Sum (DSum (..), (==>))
15+import Data.Foldable (for_)
16+import Data.Functor.Identity (Identity(..))
17+import Data.IORef (IORef, readIORef)
9−import Data.Maybe
18+import Data.Maybe (catMaybes)
19+import Data.Traversable (for)
10import Reflex
21import Reflex
11−import Control.Monad.Fix
12−import Control.Monad.Primitive
13import Reflex.Host.Class
22import Reflex.Host.Class
14−import Control.Monad.IO.Class
15−import Control.Monad.Ref
17−import Data.Dependent.Sum (DSum (..))
18−import Control.Concurrent.Chan (newChan, readChan)
19−import Control.Monad (forM, forM_)
20−import Control.Monad.Identity (Identity(..))
22type MonadHeadlessApp t m =
24type MonadHeadlessApp t m =
23− ( Reflex t
25+ ( Adjustable t m
25 , MonadFix m
26 , MonadFix m
26− , PrimMonad (HostFrame t)
27+ , MonadHold t m
28 , MonadIO (HostFrame t)
28 , MonadIO (HostFrame t)
29− , Ref m ~ IORef
29+ , MonadIO (Performable m)
30− , Ref (HostFrame t) ~ IORef
30+ , MonadIO m
31 , MonadRef (HostFrame t)
31 , MonadRef (HostFrame t)
32 , NotReady t m
32 , NotReady t m
35 , PerformEvent t m
33 , PerformEvent t m
36− , MonadIO m
34+ , PostBuild t m
37− , MonadIO (Performable m)
35+ , PrimMonad (HostFrame t)
38− , Adjustable t m
36+ , Ref (HostFrame t) ~ IORef
41-- | Run a headless FRP network. Inside the action, you will most probably use
43-- | Run a headless FRP network. Inside the action, you will most probably use
@@ -60,7 +62,7 @@ runHeadlessApp guest =
60 -- processed.
62 -- processed.
61 events <- liftIO newChan
63 events <- liftIO newChan
62 -- Run the "guest" application, providing the appropriate context. We'll
64 -- Run the "guest" application, providing the appropriate context. We'll
63− -- return the result of the action, and a 'FireCommand' that will be used to
65+ -- pure the result of the action, and a 'FireCommand' that will be used to
64 -- trigger events.
66 -- trigger events.
65 (result, fc@(FireCommand fire)) <- do
67 (result, fc@(FireCommand fire)) <- do
66 hostPerformEventT $ -- Allows the guest app to run
68 hostPerformEventT $ -- Allows the guest app to run
@@ -83,8 +85,8 @@ runHeadlessApp guest =
83 mPostBuildTrigger <- readRef postBuildTriggerRef
85 mPostBuildTrigger <- readRef postBuildTriggerRef
85 -- When there is a subscriber to the post-build event, fire the event.
87 -- When there is a subscriber to the post-build event, fire the event.
86− forM_ mPostBuildTrigger $ \postBuildTrigger ->
88+ for_ mPostBuildTrigger $ \postBuildTrigger ->
87− fire [postBuildTrigger :=> Identity ()] $ return ()
89+ fire [postBuildTrigger :=> Identity ()] $ pure ()
89 -- Subscribe to an 'Event' of that the guest application can use to
91 -- Subscribe to an 'Event' of that the guest application can use to
90 -- request application shutdown. We'll check whether this 'Event' is firing
92 -- request application shutdown. We'll check whether this 'Event' is firing
@@ -102,25 +104,25 @@ runHeadlessApp guest =
102 fireEventTriggerRefs fc ers $
104 fireEventTriggerRefs fc ers $
103 -- Check if the shutdown 'Event' is firing.
105 -- Check if the shutdown 'Event' is firing.
104 readEvent shutdown >>= \case
106 readEvent shutdown >>= \case
105− Nothing -> return False
107+ Nothing -> pure False
106− Just _ -> return True
108+ Just _ -> pure True
107 if or stop
109 if or stop
108− then return ()
110+ then pure ()
109 else loop
111 else loop
111 -- Use the given 'FireCommand' to fire events that have subscribers
113 -- Use the given 'FireCommand' to fire events that have subscribers
112 -- and call the callback for the 'TriggerInvocation' of each.
114 -- and call the callback for the 'TriggerInvocation' of each.
113 fireEventTriggerRefs
115 fireEventTriggerRefs
114− :: (MonadIO m)
116+ :: MonadIO m
115 => FireCommand t m
117 => FireCommand t m
116 -> [DSum (EventTriggerRef t) TriggerInvocation]
118 -> [DSum (EventTriggerRef t) TriggerInvocation]
117 -> ReadPhase m a
119 -> ReadPhase m a
119 fireEventTriggerRefs (FireCommand fire) ers rcb = do
121 fireEventTriggerRefs (FireCommand fire) ers rcb = do
120 mes <- liftIO $
122 mes <- liftIO $
121− forM ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do
123+ for ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do
122 me <- readIORef er
124 me <- readIORef er
123− return $ fmap (\e -> e :=> Identity a) me
125+ pure $ fmap (==> a) me
124 a <- fire (catMaybes mes) rcb
126 a <- fire (catMaybes mes) rcb
125− liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb
127+ liftIO $ for_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb