haskell - 将 requestAnimationFrame 转为 Event t()

Question

使用 Reflex-DOM，我想做一个 Event t ()当浏览器准备好绘制下一帧时触发，即 requestAnimationFrame火灾。我试过这样:

{-# LANGUAGE RecursiveDo, TypeFamilies #-}

import Reflex.Dom
import Reflex.Host.Class

import GHCJS.DOM (currentWindow)
import GHCJS.DOM.Window as Window
import GHCJS.DOM.Types (RequestAnimationFrameCallback(..))
import GHCJS.Foreign.Callback

import Control.Monad
import Control.Monad.IO.Class

refresh win = do
    (event, ref) <- newEventWithTriggerRef
    postGui <- askPostGui
    rec cb <- liftIO $ asyncCallback1 $ \_timestamp -> do
            scheduleNext
            putStrLn "about to fire the event"
            postGui $ void $ fireEventRef ref ()
            putStrLn "event fired"
        let scheduleNext = Window.requestAnimationFrame win $ Just $ RequestAnimationFrameCallback cb
        liftIO scheduleNext
    return event

我的测试应用程序如下:

main :: IO ()
main = mainWidget $ do
    Just win <- liftIO currentWindow
    tick <- refresh win
    display =<< count tick

但是，计数并没有增加。然而，在浏览器的 JS 控制台上，我确实看到了 about to fire the event。和 event fired反复打印。

Answer 1

我试过http://hackage.haskell.org/package/jsaddle-0.9.7.1/docs/Language-Javascript-JSaddle-Run.html#v:nextAnimationFrame , 但是 失败 可怜的内存泄漏无限循环。
以下工作非常好:
base-4.13.0.0,
jsaddle-0.9.7.1,
jsaddle-dom-0.9.4.1,
反射-0.8.0.0，
反射-dom-0.6.1.0

{-# LANGUAGE MonoLocalBinds      #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Reflex.Missing.AniFrame where

import qualified "base" Control.Monad.IO.Class as Monad (liftIO)
import qualified "jsaddle" Language.Javascript.JSaddle as JS (JSCallAsFunction,fun,function)
import qualified "jsaddle-dom" GHCJS.DOM as DOM (currentWindowUnchecked)
import qualified "jsaddle-dom" GHCJS.DOM.Types as DOM (liftJSM,fromJSValUnchecked,Callback(..),RequestAnimationFrameCallback(..))
import qualified "jsaddle-dom" GHCJS.DOM.Window as DOM (requestAnimationFrame_)
import qualified "reflex" Reflex as Reflex
import qualified "reflex-dom" Reflex.Dom as RDOM

type MilliSeconds = Double -- since start of program when in webkit2gtk3

requestAnimationFrameEvents :: forall t m . (RDOM.MonadWidget t m) => m (Reflex.Event t MilliSeconds)
requestAnimationFrameEvents = do
        (te,f) <- Reflex.newTriggerEvent
        let f' :: JS.JSCallAsFunction
            f' = JS.fun $ \meth this (param:_) -> do
                (t::Double) <- DOM.liftJSM $ DOM.fromJSValUnchecked param
                Monad.liftIO $ f t
        ff' <- DOM.liftJSM $ DOM.RequestAnimationFrameCallback . DOM.Callback <$> JS.function f'
        win <- DOM.liftJSM DOM.currentWindowUnchecked
        let register = DOM.requestAnimationFrame_ win ff' >> RDOM.blank
        DOM.liftJSM register
        --accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
        te' <- Reflex.accumMaybe (\past now -> if now/=past then Just now else Nothing) 0 te
        Reflex.performEvent_ $ (\_ -> DOM.liftJSM register) <$> te'
        return te'