b107049 · reflex · git.iko.soy

git.iko.soy/reflex

Create a 'ReadPhase' monad in MonadReflexHost, and use it to add MonadSample and MonadHold to the callback of fireEventsAndRead

commitb107049d037b8e2bade84a2811b7fb6c23d00c4e authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 25 Jul 2015, 16:53 (11 years ago) parent8737e59

2 files changed+15−5

compare with develop

unifiedsplit

src/Reflex/Host/Class.hs+9−2 src/Reflex/Spider/Internal.hs+6−3

src/Reflex/Host/Class.hs+9−2

@@ -53,7 +53,8 @@ class (Applicative m, Monad m) => MonadReflexCreateTrigger t m | m -> t where

5353 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)

5454 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)

5555

56−class (ReflexHost t, MonadReflexCreateTrigger t m) => MonadReflexHost t m | m -> t where

56+class (ReflexHost t, MonadReflexCreateTrigger t m, MonadReadEvent t (ReadPhase m), MonadSample t (ReadPhase m), MonadHold t (ReadPhase m)) => MonadReflexHost t m | m -> t where

57+ type ReadPhase m :: * -> *

5758 -- | Propagate some events firings and read the values of events afterwards.

5859 --

5960 -- This function will create a new frame to fire the given events. It will then update all

@@ -67,7 +68,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m) => MonadReflexHost t m | m ->

6768 -- The main loop waits for external events to happen (such as keyboard input or a mouse click)

6869 -- and then fires the corresponding events using this function. The read callback can be used

6970 -- to read output events and perform a corresponding response action to the external event.

70− fireEventsAndRead :: [DSum (EventTrigger t)] -> (forall m'. (MonadReadEvent t m') => m' a) -> m a

71+ fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a

7172

7273 -- | Subscribe to an event and set it up if needed.

7374 --

@@ -119,6 +120,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ReaderT r m

119120 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

120121

121122instance MonadReflexHost t m => MonadReflexHost t (ReaderT r m) where

123+ type ReadPhase (ReaderT r m) = ReadPhase m

122124 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

123125 subscribeEvent = lift . subscribeEvent

124126 runHostFrame = lift . runHostFrame

@@ -128,6 +130,7 @@ instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t

128130 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

129131

130132instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (WriterT w m) where

133+ type ReadPhase (WriterT w m) = ReadPhase m

131134 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

132135 subscribeEvent = lift . subscribeEvent

133136 runHostFrame = lift . runHostFrame

@@ -137,6 +140,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StateT s m)

137140 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

138141

139142instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where

143+ type ReadPhase (StateT s m) = ReadPhase m

140144 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

141145 subscribeEvent = lift . subscribeEvent

142146 runHostFrame = lift . runHostFrame

@@ -146,6 +150,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m)

146150 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

147151

148152instance MonadReflexHost t m => MonadReflexHost t (ContT r m) where

153+ type ReadPhase (ContT r m) = ReadPhase m

149154 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

150155 subscribeEvent = lift . subscribeEvent

151156 runHostFrame = lift . runHostFrame

@@ -155,6 +160,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ExceptT e m

155160 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

156161

157162instance MonadReflexHost t m => MonadReflexHost t (ExceptT e m) where

163+ type ReadPhase (ExceptT e m) = ReadPhase m

158164 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

159165 subscribeEvent = lift . subscribeEvent

160166 runHostFrame = lift . runHostFrame

@@ -164,6 +170,7 @@ instance (MonadReflexCreateTrigger t m, Monoid w) => MonadReflexCreateTrigger t

164170 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

165171

166172instance (MonadReflexHost t m, Monoid w) => MonadReflexHost t (RWST r w s m) where

173+ type ReadPhase (RWST r w s m) = ReadPhase m

167174 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

168175 subscribeEvent = lift . subscribeEvent

169176 runHostFrame = lift . runHostFrame

src/Reflex/Spider/Internal.hs+6−3

@@ -1348,9 +1348,9 @@ instance R.ReflexHost Spider where

13481348 type EventHandle Spider = SpiderEventHandle

13491349 type HostFrame Spider = SpiderHostFrame

13501350

1351−instance R.MonadReadEvent Spider ResultM where

1351+instance R.MonadReadEvent Spider ReadPhase where

13521352 {-# INLINE readEvent #-}

1353− readEvent = liftM (fmap return) . readEvent . unEventHandle

1353+ readEvent = ReadPhase . liftM (fmap return) . readEvent . unEventHandle

13541354

13551355instance MonadRef EventM where

13561356 type Ref EventM = Ref IO

@@ -1404,8 +1404,11 @@ instance R.MonadReflexCreateTrigger Spider SpiderHostFrame where

14041404 es <- newFanEventWithTriggerIO f

14051405 return $ R.EventSelector $ SpiderEvent . select es

14061406

1407+newtype ReadPhase a = ReadPhase { runReadPhase :: ResultM a } deriving (Functor, Applicative, Monad, MonadFix, R.MonadSample Spider, R.MonadHold Spider)

1408+

14071409instance R.MonadReflexHost Spider SpiderHost where

1408− fireEventsAndRead es a = SpiderHost $ run es a

1410+ type ReadPhase SpiderHost = ReadPhase

1411+ fireEventsAndRead es (ReadPhase a) = SpiderHost $ run es a

14091412 subscribeEvent e = SpiderHost $ do

14101413 _ <- runFrame $ getEventSubscribed $ unSpiderEvent e --TODO: The result of this should actually be used

14111414 return $ SpiderEventHandle (unSpiderEvent e)