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

Question

Я хотел бы создать 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 s может быть отобран только по требованию, это не обязательно.

Каков правильный способ создания Behavior для непрерывного, наблюдаемого в любое время явления?

Answer 1

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

В варианте SpiderReflex один из возможных Behavior s предназначен для вытягивания значения.

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

Pull значение изд состоит в том, как вычислить значение при необходимости, 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 An есть дискретная Pull, что достаточно, чтобы получить ссылку памяти рекурсивно прочитать invalidators недействительным и записать кэшированное значение Nothing.

Чтобы постоянно тянуть, мы хотели бы иметь возможность постоянно аннулировать наши собственные BehaviorM. При выполнении среда, переданная в BehaviorM, имеет копию собственного invalidator, которая используется зависимыми от 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: из кода кажется, что если у него есть некоторые подписные коммутаторы, они могут сломаться, если их не обработать должным образом. Хотя я не уверен, что такое поведение может иметь подписанные подписки или нет.