on develop help sign in
Implement suggestions from code review
commit3029c62b32efef3d5b466687d6255e98bc7c8e16 authorCarlo Nucera <carlo.nucera@protonmail.com> dateFri 1 May 2020, 10:50 (6 years ago) parent3e36d45
1 file changed+34−32
src/Reflex/Host/Headless.hs+34−32
src/Reflex/Host/Headless.hs+34−32
@@ -6,36 +6,38 @@
66
77module Reflex.Host.Headless where
88
9−import Data.Maybe
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)
18+import Data.Maybe (catMaybes)
19+import Data.Traversable (for)
20+
1021import Reflex
11−import Control.Monad.Fix
12−import Control.Monad.Primitive
1322import Reflex.Host.Class
14−import Control.Monad.IO.Class
15−import Control.Monad.Ref
16−import Data.IORef
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(..))
2123
2224type MonadHeadlessApp t m =
23− ( Reflex t
24− , MonadHold t m
25+ ( Adjustable t m
2526 , MonadFix m
26− , PrimMonad (HostFrame t)
27− , ReflexHost t
27+ , MonadHold t m
2828 , MonadIO (HostFrame t)
29− , Ref m ~ IORef
30− , Ref (HostFrame t) ~ IORef
29+ , MonadIO (Performable m)
30+ , MonadIO m
3131 , MonadRef (HostFrame t)
3232 , NotReady t m
33− , TriggerEvent t m
34− , PostBuild t m
3533 , PerformEvent t m
36− , MonadIO m
37− , MonadIO (Performable m)
38− , Adjustable t m
34+ , PostBuild t m
35+ , PrimMonad (HostFrame t)
36+ , Ref (HostFrame t) ~ IORef
37+ , Ref m ~ IORef
38+ , Reflex t
39+ , ReflexHost t
40+ , TriggerEvent t m
3941 )
4042
4143-- | Run a headless FRP network. Inside the action, you will most probably use
@@ -60,7 +62,7 @@ runHeadlessApp guest =
6062 -- processed.
6163 events <- liftIO newChan
6264 -- 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
6466 -- trigger events.
6567 (result, fc@(FireCommand fire)) <- do
6668 hostPerformEventT $ -- Allows the guest app to run
@@ -83,8 +85,8 @@ runHeadlessApp guest =
8385 mPostBuildTrigger <- readRef postBuildTriggerRef
8486
8587 -- When there is a subscriber to the post-build event, fire the event.
86− forM_ mPostBuildTrigger $ \postBuildTrigger ->
87− fire [postBuildTrigger :=> Identity ()] $ return ()
88+ for_ mPostBuildTrigger $ \postBuildTrigger ->
89+ fire [postBuildTrigger :=> Identity ()] $ pure ()
8890
8991 -- Subscribe to an 'Event' of that the guest application can use to
9092 -- request application shutdown. We'll check whether this 'Event' is firing
@@ -102,25 +104,25 @@ runHeadlessApp guest =
102104 fireEventTriggerRefs fc ers $
103105 -- Check if the shutdown 'Event' is firing.
104106 readEvent shutdown >>= \case
105− Nothing -> return False
106− Just _ -> return True
107+ Nothing -> pure False
108+ Just _ -> pure True
107109 if or stop
108− then return ()
110+ then pure ()
109111 else loop
110112 where
111113 -- Use the given 'FireCommand' to fire events that have subscribers
112114 -- and call the callback for the 'TriggerInvocation' of each.
113115 fireEventTriggerRefs
114− :: (MonadIO m)
116+ :: MonadIO m
115117 => FireCommand t m
116118 -> [DSum (EventTriggerRef t) TriggerInvocation]
117119 -> ReadPhase m a
118120 -> m [a]
119121 fireEventTriggerRefs (FireCommand fire) ers rcb = do
120122 mes <- liftIO $
121− forM ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do
123+ for ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do
122124 me <- readIORef er
123− return $ fmap (\e -> e :=> Identity a) me
125+ pure $ fmap (==> a) me
124126 a <- fire (catMaybes mes) rcb
125− liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb
126− return a
127+ liftIO $ for_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb
128+ pure a