@@ -7,6 +7,7 @@
77module Reflex.Host.Headless where
88
99import Control.Concurrent.Chan (newChan, readChan)
10+import Control.Monad (unless)
1011import Control.Monad.Fix (MonadFix, fix)
1112import Control.Monad.IO.Class (MonadIO, liftIO)
1213import Control.Monad.Primitive (PrimMonad)
@@ -15,7 +16,7 @@ import Data.Dependent.Sum (DSum (..), (==>))
1516import Data.Foldable (for_)
1617import Data.Functor.Identity (Identity(..))
1718import Data.IORef (IORef, readIORef)
18−import Data.Maybe (catMaybes)
19+import Data.Maybe (catMaybes, fromMaybe)
1920import Data.Traversable (for)
2021
2122import Reflex
@@ -82,32 +83,33 @@ runHeadlessApp guest =
8283 -- 'Nothing' if the guest application hasn't subscribed to this event.
8384 mPostBuildTrigger <- readRef postBuildTriggerRef
8485
85− -- When there is a subscriber to the post-build event, fire the event.
86− for_ mPostBuildTrigger $ \postBuildTrigger ->
87− fire [postBuildTrigger :=> Identity ()] $ pure ()
88−
8986 -- Subscribe to an 'Event' of that the guest application can use to
9087 -- request application shutdown. We'll check whether this 'Event' is firing
9188 -- to determine whether to terminate.
9289 shutdown <- subscribeEvent result
9390
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+
9495 -- The main application loop. We wait for new events and fire those that
9596 -- have subscribers. If we detect a shutdown request, the application
9697 -- terminates.
97− fix $ \loop -> do
98+ unless (or (fromMaybe [] soa)) $ fix $ \loop -> do
9899 -- Read the next event (blocking).
99100 ers <- liftIO $ readChan events
100101 stop <- do
101102 -- Fire events that have subscribers.
102103 fireEventTriggerRefs fc ers $
103104 -- Check if the shutdown 'Event' is firing.
104− readEvent shutdown >>= \case
105− Nothing -> pure False
106− Just _ -> pure True
105+ isFiring shutdown
107106 if or stop
108107 then pure ()
109108 else loop
110109 where
110+ isFiring ev = readEvent ev >>= \case
111+ Nothing -> pure False
112+ Just _ -> pure True
111113 -- Use the given 'FireCommand' to fire events that have subscribers
112114 -- and call the callback for the 'TriggerInvocation' of each.
113115 fireEventTriggerRefs