为连续可测量的现象创建行为

Question

我想从 IO a 创建一个 Behavior t a，其预期语义是每次行为为 sampled 时 IO 操作将为运行 :

{- language FlexibleContexts #-}
import Reflex.Dom
import Control.Monad.Trans

onDemand :: (MonadWidget t m, MonadIO (PullM t)) => IO a -> m (Behavior t a)

我希望我可以通过在 pull:

中执行 measurement 来做到这一点

onDemand measure = return $ pull (liftIO measure)

然而，结果 Behavior 在初始 measure 之后永远不会改变。

我想出的解决方法是创建一个更改 "frequently enough" 的虚拟 Behavior，然后创建一个假的依赖项：

import Data.Time.Clock as Time

hold_ :: (MonadHold t m, Reflex t) => Event t a -> m (Behavior t ())
hold_ = hold () . (() <$)

onDemand :: (MonadWidget t m, MonadIO (PullM t)) => IO a -> m (Behavior t a)
onDemand measure = do
    now <- liftIO Time.getCurrentTime
    tick <- hold_ =<< tickLossy (1/1200) now
    return $ pull $ do
        _ <- sample tick
        liftIO measure

这会按预期工作；但是由于 Behaviors 只能按需采样，所以这不是必需的。

为连续的、随时可观察的现象创建 Behavior 的正确方法是什么？

Answer 1

在 Spider 中执行此操作看起来不可能。 Internal 推理。

在 Reflex 的 Spider 实现中，一种可能的 Behavior 是提取值。

data Behavior a
   = BehaviorHold !(Hold a)
   | BehaviorConst !a
   | BehaviorPull !(Pull a)

一个 Pulled 值包括在需要时如何计算该值，pullCompute，以及一个缓存值以避免不必要的重新计算，pullValue.

data Pull a
   = Pull { pullValue :: !(IORef (Maybe (PullSubscribed a)))
          , pullCompute :: !(BehaviorM a)
          }

忽略 BehaviorM 的丑陋环境，liftIO 以明显的方式提升 IO 计算，它在 BehaviorM 需要采样时运行它。在 Pull 中，您的行为只被观察到一次，但不会再次被观察到，因为缓存值未失效。

缓存值PullSubscribed a由值a、如果该值无效则需要无效的其他值的列表以及一些无聊的内存管理内容组成。

data PullSubscribed a
   = PullSubscribed { pullSubscribedValue :: !a
                    , pullSubscribedInvalidators :: !(IORef [Weak Invalidator])
                    -- ... boring memory stuff
                    }

一个Invalidator是一个量化的Pull，它足以获取内存引用以递归读取无效器以使缓存值无效并将缓存值写入Nothing。

为了不断拉动，我们希望能够不断地使我们自己的 BehaviorM 无效。执行时，传递给 BehaviorM 的环境有一个它自己的无效器的副本，BehaviorM 的依赖项使用它在它们自己变得无效时使它无效。

从 readBehaviorTracked 的内部实现来看，行为本身的无效器 (wi) 似乎不可能最终出现在采样时无效的订阅者列表中 ( invsRef).

    a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) $ Just (wi, parentsRef)
    invsRef <- liftIO . newIORef . maybeToList =<< askInvalidator
    -- ...
    let subscribed = PullSubscribed
          { pullSubscribedValue = a
          , pullSubscribedInvalidators = invsRef
          -- ...
          }

在内部结构之外，如果确实存在一种不断采样 Behavior 的方法，它将涉及 MonadFix (PullM t) 实例或通过固定 pull and sample:[=51] 的相互递归=]

onDemand :: (Reflex t, MonadIO (PullM t)) => IO a -> Behavior t a
onDemand read = b
    where
        b = pull go
        go = do
             sample b
             liftIO read

我没有 Reflex 环境来尝试这个，但我认为结果不会很好。

Answer 2

我已经试验了一段时间并找到了解决方法。它似乎适用于最新版本的反射。诀窍是每次评估给定的 IO 操作时强制使缓存值无效。

import qualified Reflex.Spider.Internal as Spider

onDemand :: IO a -> Behavior t a
onDemand ma = SpiderBehavior . Spider.Behavior
            . Spider.BehaviorM . ReaderT $ computeF
  where
    computeF (Nothing, _) = unsafeInterleaveIO ma
    computeF (Just (invW,_), _) = unsafeInterleaveIO $ do
        toReconnect <- newIORef []
        _ <- Spider.invalidate toReconnect [invW]
        ma

尽可能晚地使用 unsafeInterleaveIO 到运行无效器很重要，这样它会使现有的东西无效。

此代码还有另一个问题：我忽略了 toReconnect 引用和 invalidate 函数的结果。在当前版本的反射中，后者始终为空，因此不会造成任何问题。但是我不确定toReconnect：从代码来看，似乎如果它有一些订阅的开关，如果处理不当，它们可能会中断。虽然我不确定这种行为是否可以订阅开关。

UPDATE 对于那些真正想要实现这个的人：上面的代码在一些复杂的设置中可能会死锁。我的解决方案是在单独的线程中计算本身之后稍微执行无效。 Here is the complete code snippet。 link 的解决方案似乎工作正常（现在在生产中使用了将近一年）。

为连续可测量的现象创建行为

Creating a Behavior for a continuously measurable phenomenon

haskell

ghcjs

reflex