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

b107049Ryan Trinkle11 years ago

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

compare with develop

unifiedsplit

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

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

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

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 :: * -> *

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

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

58 --

59 --

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

60 -- 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 ->

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

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

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

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

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

70 -- 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

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

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

73 --

74 --

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

119 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

120 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

120

121

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

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

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

122 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

124 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

123 subscribeEvent = lift . subscribeEvent

125 subscribeEvent = lift . subscribeEvent

124 runHostFrame = lift . runHostFrame

126 runHostFrame = lift . runHostFrame

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

128 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

130 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

129

131

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

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

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

131 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

134 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

132 subscribeEvent = lift . subscribeEvent

135 subscribeEvent = lift . subscribeEvent

133 runHostFrame = lift . runHostFrame

136 runHostFrame = lift . runHostFrame

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

137 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

140 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

138

141

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

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

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

140 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

144 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

141 subscribeEvent = lift . subscribeEvent

145 subscribeEvent = lift . subscribeEvent

142 runHostFrame = lift . runHostFrame

146 runHostFrame = lift . runHostFrame

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

146 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

150 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

147

151

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

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

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

149 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

154 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

150 subscribeEvent = lift . subscribeEvent

155 subscribeEvent = lift . subscribeEvent

151 runHostFrame = lift . runHostFrame

156 runHostFrame = lift . runHostFrame

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

155 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

160 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

156

161

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

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

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

158 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

164 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

159 subscribeEvent = lift . subscribeEvent

165 subscribeEvent = lift . subscribeEvent

160 runHostFrame = lift . runHostFrame

166 runHostFrame = lift . runHostFrame

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

164 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

170 newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer

165

171

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

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

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

167 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

174 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

168 subscribeEvent = lift . subscribeEvent

175 subscribeEvent = lift . subscribeEvent

169 runHostFrame = lift . runHostFrame

176 runHostFrame = lift . runHostFrame

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

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

1348 type EventHandle Spider = SpiderEventHandle

1349 type HostFrame Spider = SpiderHostFrame

1350

1351−instance R.MonadReadEvent Spider ResultM where

1351+instance R.MonadReadEvent Spider ReadPhase where

1352 {-# INLINE readEvent #-}

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

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

1354

1355instance MonadRef EventM where

1356 type Ref EventM = Ref IO

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

1404 es <- newFanEventWithTriggerIO f

1405 return $ R.EventSelector $ SpiderEvent . select es

1406

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

1408+

1407instance R.MonadReflexHost Spider SpiderHost where

1409instance R.MonadReflexHost Spider SpiderHost where

1410+ type ReadPhase SpiderHost = ReadPhase

1408− fireEventsAndRead es a = SpiderHost $ run es a

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

1409 subscribeEvent e = SpiderHost $ do

1412 subscribeEvent e = SpiderHost $ do

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

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

1411 return $ SpiderEventHandle (unSpiderEvent e)

1414 return $ SpiderEventHandle (unSpiderEvent e)