8b985a2 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge pull request #148 from reflex-frp/request-animation-frame-everything

8b985a2Ryan Trinkle10 years ago

reflex-dom-core/src-ghc/Foreign/JavaScript/Internal/Utils.hs+11−3

compare with develop

unifiedsplit

@@ -1,9 +1,17 @@

1module Foreign.JavaScript.Internal.Utils

2+ ( synchronously

3+ , freeRequestAnimationFrameCallback

2− ( js_dataView

4+ , js_dataView

3 ) where

5 ) where

5−import Language.Javascript.JSaddle.Types (JSVal, JSM)

7+import GHCJS.DOM.Types (JSM, JSVal, RequestAnimationFrameCallback (..), Callback (..))

6−import Language.Javascript.JSaddle.Object (new, jsg)

8+import Language.Javascript.JSaddle.Object (freeFunction, new, jsg)

10+synchronously :: JSM a -> JSM a

11+synchronously = id

12+

13+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()

14+freeRequestAnimationFrameCallback (RequestAnimationFrameCallback (Callback cb)) = freeFunction cb

8js_dataView :: Int -> Int -> JSVal -> JSM JSVal

16js_dataView :: Int -> Int -> JSVal -> JSM JSVal

9js_dataView off len ref = new (jsg "DataView") (ref, off, len)

17js_dataView off len ref = new (jsg "DataView") (ref, off, len)

reflex-dom-core/src-ghcjs/Foreign/JavaScript/Internal/Utils.hs+9−2

@@ -2,10 +2,17 @@

2{-# LANGUAGE JavaScriptFFI #-}

4module Foreign.JavaScript.Internal.Utils

5+ ( synchronously

6+ , freeRequestAnimationFrameCallback

5− ( js_dataView

7+ , js_dataView

6 ) where

8 ) where

8−import Language.Javascript.JSaddle.Types (JSVal)

10+import GHCJS.Concurrent

11+import GHCJS.DOM.Types (JSVal, JSM, RequestAnimationFrameCallback (..))

12+import GHCJS.Foreign.Callback (releaseCallback)

13+

14+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()

15+freeRequestAnimationFrameCallback (RequestAnimationFrameCallback cb) = releaseCallback cb

10foreign import javascript safe "new DataView($3,$1,$2)"

17foreign import javascript safe "new DataView($3,$1,$2)"

11 js_dataView :: Int -> Int -> JSVal -> IO JSVal

18 js_dataView :: Int -> Int -> JSVal -> IO JSVal

reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+8−4

@@ -5,13 +5,14 @@ module Foreign.JavaScript.Orphans where

6#ifndef __GHCJS__

8−import Reflex.Host.Class (ReflexHost, HostFrame)

9import Control.Monad.Trans.Class (lift)

8import Control.Monad.Trans.Class (lift)

10−import Reflex.PostBuild.Base (PostBuildT)

9+import GHCJS.DOM.Types (MonadJSM(..))

11−import Reflex.PerformEvent.Base (PerformEventT(..))

12import Reflex.DynamicWriter (DynamicWriterT)

10import Reflex.DynamicWriter (DynamicWriterT)

11+import Reflex.Host.Class (ReflexHost, HostFrame)

12+import Reflex.PerformEvent.Base (PerformEventT(..))

13+import Reflex.PostBuild.Base (PostBuildT)

13import Reflex.Requester.Base (RequesterT)

14import Reflex.Requester.Base (RequesterT)

14−import GHCJS.DOM.Types (MonadJSM(..))

15+import Reflex.TriggerEvent.Base

16instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where

17instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where

17 liftJSM' = lift . liftJSM'

18 liftJSM' = lift . liftJSM'

@@ -25,4 +26,7 @@ instance MonadJSM m => MonadJSM (DynamicWriterT t w m) where

25instance MonadJSM m => MonadJSM (RequesterT t request response m) where

26instance MonadJSM m => MonadJSM (RequesterT t request response m) where

26 liftJSM' = lift . liftJSM'

27 liftJSM' = lift . liftJSM'

29+instance MonadJSM m => MonadJSM (TriggerEventT t m) where

30+ liftJSM' = lift . liftJSM'

31+

28#endif

32#endif

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+47−31

@@ -22,7 +22,7 @@

22{-# LANGUAGE TypeOperators #-}

23{-# LANGUAGE UndecidableInstances #-}

24module Reflex.Dom.Builder.Immediate

25− ( TriggerRef (..)

25+ ( EventTriggerRef (..)

26 , ImmediateDomBuilderEnv (..)

27 , ImmediateDomBuilderT (..)

28 , runImmediateDomBuilderT

@@ -87,9 +87,10 @@ import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

87import Reflex.PerformEvent.Class

88import Reflex.PostBuild.Class

89import Reflex.TriggerEvent.Base hiding (askEvents)

90+import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

90import Reflex.TriggerEvent.Class

91import Reflex.TriggerEvent.Class

92−import Control.Concurrent.Chan

93+import Control.Concurrent

93import Control.Lens hiding (element, ix)

94import Control.Lens hiding (element, ix)

94import Control.Monad.Exception

95import Control.Monad.Exception

95import Control.Monad.Primitive

96import Control.Monad.Primitive

@@ -115,6 +116,8 @@ import Data.Some (Some)

115import qualified Data.Some as Some

116import qualified Data.Some as Some

116import Data.Text (Text)

117import Data.Text (Text)

117import qualified Data.Text as T

118import qualified Data.Text as T

119+import qualified GHCJS.DOM as DOM

120+import GHCJS.DOM.RequestAnimationFrameCallback

118import GHCJS.DOM.Document (Document, createDocumentFragmentUnchecked, createElementUnchecked, createElementNSUnchecked, createTextNodeUnchecked)

121import GHCJS.DOM.Document (Document, createDocumentFragmentUnchecked, createElementUnchecked, createElementNSUnchecked, createTextNodeUnchecked)

119import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)

122import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)

120import qualified GHCJS.DOM.Element as Element

123import qualified GHCJS.DOM.Element as Element

@@ -142,18 +145,17 @@ import Language.Javascript.JSaddle (call, eval)

142

145

143import Reflex.Requester.Base

146import Reflex.Requester.Base

144import Reflex.Requester.Class

147import Reflex.Requester.Class

145−

148+import Foreign.JavaScript.Internal.Utils

146−data TriggerRef t a = TriggerRef { unTriggerRef :: IORef (Maybe (EventTrigger t a)) }

147

149

148data ImmediateDomBuilderEnv t

150data ImmediateDomBuilderEnv t

149 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

151 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

150 , _immediateDomBuilderEnv_parent :: Node

152 , _immediateDomBuilderEnv_parent :: Node

151− , _immediateDomBuilderEnv_events :: Chan [DSum (TriggerRef t) TriggerInvocation]

152 , _immediateDomBuilderEnv_unreadyChildren :: IORef Word -- Number of children who still aren't fully rendered

153 , _immediateDomBuilderEnv_unreadyChildren :: IORef Word -- Number of children who still aren't fully rendered

153 , _immediateDomBuilderEnv_commitAction :: JSM () -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it

154 , _immediateDomBuilderEnv_commitAction :: JSM () -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it

154 }

155 }

155

156

156−newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t) (RequesterT t JSM Identity m) a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)

157+newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t) (RequesterT t JSM Identity (TriggerEventT t m)) a }

158+ deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)

157

159

158#ifndef __GHCJS__

160#ifndef __GHCJS__

159instance MonadJSM m => MonadJSM (ImmediateDomBuilderT t m) where

161instance MonadJSM m => MonadJSM (ImmediateDomBuilderT t m) where

@@ -165,7 +167,7 @@ instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where

165 primitive = lift . primitive

167 primitive = lift . primitive

166

168

167instance MonadTrans (ImmediateDomBuilderT t) where

169instance MonadTrans (ImmediateDomBuilderT t) where

168− lift = ImmediateDomBuilderT . lift . lift

170+ lift = ImmediateDomBuilderT . lift . lift . lift

169

171

170instance (Reflex t, PrimMonad m) => DomRenderHook t (ImmediateDomBuilderT t m) where

172instance (Reflex t, PrimMonad m) => DomRenderHook t (ImmediateDomBuilderT t m) where

171 withRenderHook hook (ImmediateDomBuilderT a) = do

173 withRenderHook hook (ImmediateDomBuilderT a) = do

@@ -177,11 +179,34 @@ instance (Reflex t, PrimMonad m) => DomRenderHook t (ImmediateDomBuilderT t m) w

177 requestDomAction_ = ImmediateDomBuilderT . lift . requesting_

179 requestDomAction_ = ImmediateDomBuilderT . lift . requesting_

178

180

179{-# INLINABLE runImmediateDomBuilderT #-}

181{-# INLINABLE runImmediateDomBuilderT #-}

180−runImmediateDomBuilderT :: (Reflex t, MonadFix m, PerformEvent t m, MonadJSM (Performable m)) => ImmediateDomBuilderT t m a -> ImmediateDomBuilderEnv t -> m a

182+runImmediateDomBuilderT

183+ :: ( Reflex t

184+ , MonadFix m

185+ , PerformEvent t m

186+ , MonadReflexCreateTrigger t m

187+ , MonadJSM m

188+ , MonadJSM (Performable m)

189+ , MonadRef m

190+ , Ref m ~ IORef

191+ )

192+ => ImmediateDomBuilderT t m a

193+ -> ImmediateDomBuilderEnv t

194+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

195+ -> m a

181−runImmediateDomBuilderT (ImmediateDomBuilderT a) env = do

196+runImmediateDomBuilderT (ImmediateDomBuilderT a) env eventChan = flip runTriggerEventT eventChan $ do

197+ win <- DOM.currentWindowUnchecked

182 rec (x, req) <- runRequesterT (runReaderT a env) rsp

198 rec (x, req) <- runRequesterT (runReaderT a env) rsp

199+ rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame win f $

183− rsp <- performEvent $ ffor req $ \rm -> liftJSM $ DMap.traverseWithKey (\_ r -> Identity <$> r) rm

200+ DMap.traverseWithKey (\_ r -> Identity <$> r) rm

184 return x

201 return x

202+ where

203+ runInAnimationFrame win f x = do

204+ rec cb <- newRequestAnimationFrameCallbackSync $ \_ -> do

205+ v <- synchronously x

206+ _ <- liftIO $ f v

207+ freeRequestAnimationFrameCallback cb

208+ _ <- Window.requestAnimationFrame win $ Just cb

209+ return ()

185

210

186{-# INLINABLE askDocument #-}

211{-# INLINABLE askDocument #-}

187askDocument :: Monad m => ImmediateDomBuilderT t m Document

212askDocument :: Monad m => ImmediateDomBuilderT t m Document

@@ -192,8 +217,8 @@ askParent :: Monad m => ImmediateDomBuilderT t m Node

192askParent = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_parent

217askParent = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_parent

193

218

194{-# INLINABLE askEvents #-}

219{-# INLINABLE askEvents #-}

195−askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (TriggerRef t) TriggerInvocation])

220+askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])

196−askEvents = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_events

221+askEvents = ImmediateDomBuilderT . lift . lift $ TriggerEventT.askEvents

197

222

198localEnv :: Monad m => (ImmediateDomBuilderEnv t -> ImmediateDomBuilderEnv t) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m a

223localEnv :: Monad m => (ImmediateDomBuilderEnv t -> ImmediateDomBuilderEnv t) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m a

199localEnv f = ImmediateDomBuilderT . local f . unImmediateDomBuilderT

224localEnv f = ImmediateDomBuilderT . local f . unImmediateDomBuilderT

@@ -296,7 +321,7 @@ wrap e cfg = do

296 Propagation_Stop -> withIsEvent en DOM.stopPropagation

321 Propagation_Stop -> withIsEvent en DOM.stopPropagation

297 Propagation_StopImmediate -> withIsEvent en DOM.stopImmediatePropagation

322 Propagation_StopImmediate -> withIsEvent en DOM.stopImmediatePropagation

298 mv <- liftJSM k --TODO: Only do this when the event is subscribed

323 mv <- liftJSM k --TODO: Only do this when the event is subscribed

299− liftIO $ forM_ mv $ \v -> writeChan events [TriggerRef triggerRef :=> TriggerInvocation v (return ())]

324+ liftIO $ forM_ mv $ \v -> writeChan events [EventTriggerRef triggerRef :=> TriggerInvocation v (return ())]

300 return $ en :=> EventFilterTriggerRef triggerRef

325 return $ en :=> EventFilterTriggerRef triggerRef

301 es <- do

326 es <- do

302 let h :: GhcjsEventHandler er

327 let h :: GhcjsEventHandler er

@@ -316,7 +341,7 @@ wrap e cfg = do

316 Just v -> liftIO $ do

341 Just v -> liftIO $ do

317 --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right

342 --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right

318 ref <- newIORef $ Just t

343 ref <- newIORef $ Just t

319− writeChan events [TriggerRef ref :=> TriggerInvocation v (return ())])

344+ writeChan events [EventTriggerRef ref :=> TriggerInvocation v (return ())])

320 return $ Element

345 return $ Element

321 { _element_events = es

346 { _element_events = es

322 , _element_raw = e

347 , _element_raw = e

@@ -723,10 +748,10 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

723 , Patch (p k (Constant Int))

748 , Patch (p k (Constant Int))

724 )

749 )

725 => (forall vv vv'.

750 => (forall vv vv'.

726− (forall a. k a -> vv a -> RequesterT t JSM Identity m (vv' a))

751+ (forall a. k a -> vv a -> RequesterT t JSM Identity (TriggerEventT t m) (vv' a))

727 -> DMap k vv

752 -> DMap k vv

728 -> Event t (p k vv)

753 -> Event t (p k vv)

729− -> RequesterT t JSM Identity m (DMap k vv', Event t (p k vv'))

754+ -> RequesterT t JSM Identity (TriggerEventT t m) (DMap k vv', Event t (p k vv'))

730 ) -- ^ The base monad's traversal

755 ) -- ^ The base monad's traversal

731 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type

756 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type

732 -> (p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state

757 -> (p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state

@@ -802,7 +827,7 @@ drawChildUpdate :: (MonadIO m, MonadJSM m)

802 => ImmediateDomBuilderEnv t

827 => ImmediateDomBuilderEnv t

803 -> (IORef (ChildReadyState k) -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready

828 -> (IORef (ChildReadyState k) -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready

804 -> ImmediateDomBuilderT t m (v' a)

829 -> ImmediateDomBuilderT t m (v' a)

805− -> RequesterT t JSM Identity m (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)

830+ -> RequesterT t JSM Identity (TriggerEventT t m) (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)

806drawChildUpdate initialEnv markReady child = do

831drawChildUpdate initialEnv markReady child = do

807 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

832 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

808 unreadyChildren <- liftIO $ newIORef 0

833 unreadyChildren <- liftIO $ newIORef 0

@@ -848,20 +873,11 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ImmediateDo

848

873

849instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (ImmediateDomBuilderT t m) where

874instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (ImmediateDomBuilderT t m) where

850 {-# INLINABLE newTriggerEvent #-}

875 {-# INLINABLE newTriggerEvent #-}

851− newTriggerEvent = do

876+ newTriggerEvent = ImmediateDomBuilderT . lift . lift $ newTriggerEvent

852− (e, t) <- newTriggerEventWithOnComplete

853− return (e, \a -> t a $ return ())

854 {-# INLINABLE newTriggerEventWithOnComplete #-}

877 {-# INLINABLE newTriggerEventWithOnComplete #-}

855− newTriggerEventWithOnComplete = do

878+ newTriggerEventWithOnComplete = ImmediateDomBuilderT . lift . lift $ newTriggerEventWithOnComplete

856− events <- askEvents

857− (eResult, reResultTrigger) <- lift newEventWithTriggerRef

858− return $ (,) eResult $ \a cb -> writeChan events [TriggerRef reResultTrigger :=> TriggerInvocation a (liftIO cb)]

859 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}

879 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}

860− newEventWithLazyTriggerWithOnComplete f = do

880+ newEventWithLazyTriggerWithOnComplete f = ImmediateDomBuilderT . lift . lift $ newEventWithLazyTriggerWithOnComplete f

861− events <- askEvents

862− lift $ newEventWithTrigger $ \t -> f $ \a cb -> do

863− reResultTrigger <- newIORef $ Just t

864− writeChan events [TriggerRef reResultTrigger :=> TriggerInvocation a (liftIO cb)]

865

881

866instance HasJSContext m => HasJSContext (ImmediateDomBuilderT t m) where

882instance HasJSContext m => HasJSContext (ImmediateDomBuilderT t m) where

867 type JSContextPhantom (ImmediateDomBuilderT t m) = JSContextPhantom m

883 type JSContextPhantom (ImmediateDomBuilderT t m) = JSContextPhantom m

@@ -1238,7 +1254,7 @@ wrapDomEvent el elementOnevent getValue = wrapDomEventMaybe el elementOnevent $

1238{-# INLINABLE subscribeDomEvent #-}

1254{-# INLINABLE subscribeDomEvent #-}

1239subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))

1255subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))

1240 -> EventM e event (Maybe a)

1256 -> EventM e event (Maybe a)

1241− -> Chan [DSum (TriggerRef t) TriggerInvocation]

1257+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

1242 -> EventTrigger t a

1258 -> EventTrigger t a

1243 -> JSM (JSM ())

1259 -> JSM (JSM ())

1244subscribeDomEvent elementOnevent getValue eventChan et = elementOnevent $ do

1260subscribeDomEvent elementOnevent getValue eventChan et = elementOnevent $ do

@@ -1246,7 +1262,7 @@ subscribeDomEvent elementOnevent getValue eventChan et = elementOnevent $ do

1246 forM_ mv $ \v -> liftIO $ do

1262 forM_ mv $ \v -> liftIO $ do

1247 --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right

1263 --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right

1248 etr <- newIORef $ Just et

1264 etr <- newIORef $ Just et

1249− writeChan eventChan [TriggerRef etr :=> TriggerInvocation v (return ())]

1265+ writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]

1250

1266

1251{-# INLINABLE wrapDomEventMaybe #-}

1267{-# INLINABLE wrapDomEventMaybe #-}

1252wrapDomEventMaybe :: (TriggerEvent t m, MonadJSM m)

1268wrapDomEventMaybe :: (TriggerEvent t m, MonadJSM m)

reflex-dom-core/src/Reflex/Dom/Main.hs+4−6

@@ -94,11 +94,10 @@ mainWidgetWithHead' widgets = withJSContextSingletonMono $ \jsSing -> do

94 let builderEnv = ImmediateDomBuilderEnv

95 { _immediateDomBuilderEnv_document = toDocument doc

96 , _immediateDomBuilderEnv_parent = toNode df

97− , _immediateDomBuilderEnv_events = events

98 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren

97 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren

99 , _immediateDomBuilderEnv_commitAction = return () --TODO

98 , _immediateDomBuilderEnv_commitAction = return () --TODO

100 }

99 }

101− runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing

100+ runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing

102 rec b <- go (headWidget a) headFragment

101 rec b <- go (headWidget a) headFragment

103 a <- go (bodyWidget b) bodyFragment

102 a <- go (bodyWidget b) bodyFragment

104 return (events, postBuildTriggerRef)

103 return (events, postBuildTriggerRef)

@@ -123,17 +122,16 @@ attachWidget' rootElement jsSing w = do

123 let builderEnv = ImmediateDomBuilderEnv

122 let builderEnv = ImmediateDomBuilderEnv

124 { _immediateDomBuilderEnv_document = toDocument doc

123 { _immediateDomBuilderEnv_document = toDocument doc

125 , _immediateDomBuilderEnv_parent = toNode df

124 , _immediateDomBuilderEnv_parent = toNode df

126− , _immediateDomBuilderEnv_events = events

127 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren

125 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren

128 , _immediateDomBuilderEnv_commitAction = return () --TODO

126 , _immediateDomBuilderEnv_commitAction = return () --TODO

129 }

127 }

130− a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing

128+ a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing

131 return ((a, events), postBuildTriggerRef)

129 return ((a, events), postBuildTriggerRef)

132 replaceElementContents rootElement df

130 replaceElementContents rootElement df

133 liftIO $ processAsyncEvents events fc

131 liftIO $ processAsyncEvents events fc

134 return (a, fc)

132 return (a, fc)

135

133

136−type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

134+type EventChannel = Chan [DSum (EventTriggerRef Spider) TriggerInvocation]

137

135

138{-# INLINABLE attachWidget'' #-}

136{-# INLINABLE attachWidget'' #-}

139attachWidget'' :: (EventChannel -> PerformEventT Spider (SpiderHost Global) (a, IORef (Maybe (EventTrigger Spider ())))) -> IO (a, FireCommand Spider (SpiderHost Global))

137attachWidget'' :: (EventChannel -> PerformEventT Spider (SpiderHost Global) (a, IORef (Maybe (EventTrigger Spider ())))) -> IO (a, FireCommand Spider (SpiderHost Global))

@@ -149,7 +147,7 @@ processAsyncEvents :: EventChannel -> FireCommand Spider (SpiderHost Global) ->

149processAsyncEvents events (FireCommand fire) = void $ forkIO $ forever $ do

147processAsyncEvents events (FireCommand fire) = void $ forkIO $ forever $ do

150 ers <- readChan events

148 ers <- readChan events

151 _ <- runSpiderHost $ do

149 _ <- runSpiderHost $ do

152− mes <- liftIO $ forM ers $ \(TriggerRef er :=> TriggerInvocation a _) -> do

150+ mes <- liftIO $ forM ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do

153 me <- readIORef er

151 me <- readIORef er

154 return $ fmap (\e -> e :=> Identity a) me

152 return $ fmap (\e -> e :=> Identity a) me

155 _ <- fire (catMaybes mes) $ return ()

153 _ <- fire (catMaybes mes) $ return ()