@@ -7,6 +7,7 @@
7module Reflex.Host.Headless where
7module Reflex.Host.Headless where
9import Control.Concurrent.Chan (newChan, readChan)
9import Control.Concurrent.Chan (newChan, readChan)
10+import Control.Monad (unless)
10import Control.Monad.Fix (MonadFix, fix)
11import Control.Monad.Fix (MonadFix, fix)
11import Control.Monad.IO.Class (MonadIO, liftIO)
12import Control.Monad.IO.Class (MonadIO, liftIO)
12import Control.Monad.Primitive (PrimMonad)
13import Control.Monad.Primitive (PrimMonad)
@@ -15,7 +16,7 @@ import Data.Dependent.Sum (DSum (..), (==>))
15import Data.Foldable (for_)
16import Data.Foldable (for_)
16import Data.Functor.Identity (Identity(..))
17import Data.Functor.Identity (Identity(..))
17import Data.IORef (IORef, readIORef)
18import Data.IORef (IORef, readIORef)
18−import Data.Maybe (catMaybes)
19+import Data.Maybe (catMaybes, fromMaybe)
19import Data.Traversable (for)
20import Data.Traversable (for)
21import Reflex
22import Reflex
@@ -82,32 +83,33 @@ runHeadlessApp guest =
82 -- 'Nothing' if the guest application hasn't subscribed to this event.
83 -- 'Nothing' if the guest application hasn't subscribed to this event.
83 mPostBuildTrigger <- readRef postBuildTriggerRef
84 mPostBuildTrigger <- readRef postBuildTriggerRef
85− -- When there is a subscriber to the post-build event, fire the event.
86− for_ mPostBuildTrigger $ \postBuildTrigger ->
87− fire [postBuildTrigger :=> Identity ()] $ pure ()
89 -- Subscribe to an 'Event' of that the guest application can use to
86 -- Subscribe to an 'Event' of that the guest application can use to
90 -- request application shutdown. We'll check whether this 'Event' is firing
87 -- request application shutdown. We'll check whether this 'Event' is firing
91 -- to determine whether to terminate.
88 -- to determine whether to terminate.
92 shutdown <- subscribeEvent result
89 shutdown <- subscribeEvent result
91+ -- When there is a subscriber to the post-build event, fire the event.
92+ soa <- for mPostBuildTrigger $ \postBuildTrigger ->
93+ fire [postBuildTrigger :=> Identity ()] $ isFiring shutdown
94 -- The main application loop. We wait for new events and fire those that
95 -- The main application loop. We wait for new events and fire those that
95 -- have subscribers. If we detect a shutdown request, the application
96 -- have subscribers. If we detect a shutdown request, the application
96 -- terminates.
97 -- terminates.
97− fix $ \loop -> do
98+ unless (or (fromMaybe [] soa)) $ fix $ \loop -> do
98 -- Read the next event (blocking).
99 -- Read the next event (blocking).
99 ers <- liftIO $ readChan events
100 ers <- liftIO $ readChan events
100 stop <- do
101 stop <- do
101 -- Fire events that have subscribers.
102 -- Fire events that have subscribers.
102 fireEventTriggerRefs fc ers $
103 fireEventTriggerRefs fc ers $
103 -- Check if the shutdown 'Event' is firing.
104 -- Check if the shutdown 'Event' is firing.
104− readEvent shutdown >>= \case
105+ isFiring shutdown
105− Nothing -> pure False
107 if or stop
106 if or stop
108 then pure ()
107 then pure ()
109 else loop
108 else loop
110+ isFiring ev = readEvent ev >>= \case
111+ Nothing -> pure False
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