1a29cfa · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Run DOM updates in an animation frame.

commit1a29cfaf36f90d8b08551a2a92e72c60d764c586 authorWill Fancher <elvishjerricco@gmail.com> dateTue 25 Apr 2017, 14:57 (10 years ago) parent63c5fcd

4 files changed+51−3

compare with develop

unifiedsplit

reflex-dom-core/reflex-dom-core.cabal+3 reflex-dom-core/src-ghc/Foreign/JavaScript/Internal/Utils.hs+13 reflex-dom-core/src-ghcjs/Foreign/JavaScript/Internal/Utils.hs+11 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+24−3

reflex-dom-core/reflex-dom-core.cabal+3

@@ -74,10 +74,12 @@ library

7474 zenc == 0.1.*

7575

7676 if impl(ghcjs)

77+ hs-source-dirs: src-ghcjs

7778 build-depends:

7879 ghcjs-base,

7980 hashable == 1.2.*

8081 else

82+ hs-source-dirs: src-ghc

8183 if !os(windows)

8284 build-depends: unix == 2.7.*

8385

@@ -103,6 +105,7 @@ library

103105 Reflex.Dom.Widget.Resize

104106 Reflex.Dom.Xhr

105107 other-modules:

108+ Foreign.JavaScript.Internal.Utils

106109 Reflex.Dom.WebSocket.Foreign

107110 Reflex.Dom.Xhr.Foreign

108111 Reflex.Dom.Xhr.ResponseType

reflex-dom-core/src-ghc/Foreign/JavaScript/Internal/Utils.hsnew file+13

@@ -0,0 +1,13 @@

1+module Foreign.JavaScript.Internal.Utils

2+ ( synchronously

3+ , freeRequestAnimationFrameCallback

4+ ) where

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

7+import Language.Javascript.JSaddle.Object (freeFunction)

9+synchronously :: JSM a -> JSM a

10+synchronously = id

11+

12+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()

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

reflex-dom-core/src-ghcjs/Foreign/JavaScript/Internal/Utils.hsnew file+11

@@ -0,0 +1,11 @@

1+module Foreign.JavaScript.Internal.Utils

2+ ( synchronously

3+ , freeRequestAnimationFrameCallback

4+ ) where

6+import GHCJS.Concurrent

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

8+import GHCJS.Foreign.Callback (releaseCallback)

10+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()

11+freeRequestAnimationFrameCallback (RequestAnimationFrameCallback cb) = releaseCallback cb

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+24−3

@@ -88,7 +88,7 @@ import Reflex.PostBuild.Class

8888import Reflex.TriggerEvent.Base hiding (askEvents)

8989import Reflex.TriggerEvent.Class

9090

91−import Control.Concurrent.Chan

91+import Control.Concurrent

9292import Control.Lens hiding (element, ix)

9393import Control.Monad.Exception

9494import Control.Monad.Primitive

@@ -112,6 +112,8 @@ import Data.Monoid

112112import qualified Data.Some as Some

113113import Data.Text (Text)

114114import qualified Data.Text as T

115+import qualified GHCJS.DOM as DOM

116+import GHCJS.DOM.RequestAnimationFrameCallback

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

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

117119import qualified GHCJS.DOM.Element as Element

@@ -139,6 +141,7 @@ import Language.Javascript.JSaddle (call, eval)

139141

140142import Reflex.Requester.Base

141143import Reflex.Requester.Class

144+import Foreign.JavaScript.Internal.Utils

142145

143146data ImmediateDomBuilderEnv t m

144147 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

@@ -172,14 +175,32 @@ instance (PerformEvent t m, PrimMonad m) => DomRenderHook t (ImmediateDomBuilder

172175

173176{-# INLINABLE runImmediateDomBuilderT #-}

174177runImmediateDomBuilderT

175− :: (Reflex t, MonadFix m, PerformEvent t m, MonadJSM m, MonadJSM (Performable m))

178+ :: ( Reflex t

179+ , MonadFix m

180+ , PerformEvent t m

181+ , MonadReflexCreateTrigger t m

182+ , MonadJSM m

183+ , MonadJSM (Performable m)

184+ , MonadRef m

185+ , Ref m ~ IORef

186+ )

176187 => ImmediateDomBuilderT t m a

177188 -> ImmediateDomBuilderEnv t m

178189 -> m a

179190runImmediateDomBuilderT (ImmediateDomBuilderT a) env = flip runTriggerEventT (_immediateDomBuilderEnv_events env) $ do

191+ win <- DOM.currentWindowUnchecked

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

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

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

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

182195 return x

196+ where

197+ runInAnimationFrame win f x = do

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

199+ v <- synchronously x

200+ _ <- liftIO $ f v

201+ freeRequestAnimationFrameCallback cb

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

203+ return ()

183204

184205{-# INLINABLE askDocument #-}

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