Создание поведения для непрерывно измеряемого явления

Я хотел бы создать Behavior t a из IO a с предполагаемой семантикой, что действие IO будет выполняться каждый раз, когда поведение sample d:

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

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

Я надеялся, что смогу сделать это, просто выполнив measurement в pull:

onDemand measure = return $ pull (liftIO measure)

Однако результирующий Behavior никогда не изменяется после начального measure.

Обходной путь, который я мог придумать, заключался в создании манекена 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 для непрерывного явления, наблюдаемого в любое время?

Ответ 1

Выполнение этого в Spider выглядит невозможным. Internal рассуждения впереди.

В реализации Spider Reflex одним из возможных Behavior является вытягивание значения.

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

A Pull значение ed состоит из того, как вычислить значение, когда необходимо, pullCompute и кешированное значение, чтобы избежать ненужных повторений -comput, 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
                    }

An Invalidator - это квантифицированный Pull, который достаточно, чтобы получить ссылку на память для рекурсивного чтения недействительных, чтобы сделать недействительными и записать кэшированные значение Nothing.

Чтобы постоянно тянуть, мы хотели бы иметь возможность постоянно аннулировать наш собственный BehaviorM. Когда выполняется, среда, переданная в BehaviorM, имеет копию собственного invalidator, которая используется зависимостями BehaviorM, чтобы аннулировать ее, когда они сами стали недействительными.

Из внутренней реализации readBehaviorTracked похоже, что поведение собственного invalidator (wi) никогда не может закончиться в списке подписчиков, которые недействительны при его выборке (invsRef).

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

Вне внутренних элементов, если существует способ постоянного выбора a 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, чтобы попробовать это, но я не думаю, что результаты будут хорошими.

Ответ 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 для запуска invalidator как можно позже, чтобы он недействил существующее.

С этим кодом возникает другая проблема: я игнорирую ссылку toReconnect и результат функции invalidate. В текущей версии рефлекса последний всегда пуст, поэтому он не должен вызывать никаких проблем. Но я не уверен в toReconnect: из кода кажется, что если у него есть некоторые подписные коммутаторы, они могут сломаться, если их не обработать должным образом. Хотя я не уверен, что такое поведение может быть подписано или нет.