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

Question

我想从IO a创建一个Behavior t a，其预期语义是每次sample行为时都会运行IO操作 d：

{- 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)

但是，在初始measure后，生成的Behavior永远不会改变。

我能想到的解决方法是创建一个"足够频繁"更改的虚拟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

然后按预期工作;但由于Behavior无论如何都只能按需采样，所以这不是必需的。

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

Answer 1

在Spider中这样做看起来是不可能的。 Internal推理在前面。

在Reflex的Spider实现中，一个可能Behavior就是拉取值。

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

Pull ed 值包括如何在需要时计算值，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和sample进行相互递归：

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：从代码来看，如果它有一些订阅的交换机，如果处理不当，它们可能会损坏。虽然我不确定这种行为是否可以订阅开关。

对于那些真正想要实现这一点的人的更新：上面的代码可能会在某些复杂的设置中死锁。我的解决方案是在计算本身之后在单独的线程中稍微执行失效。这是完整的代码片段。链接的解决方案似乎工作正常（现在在生产中使用了将近一年）。