Pull-based behaviors?

reactive-banana/src/Reactive/Banana/Frameworks.hs

@@ -18,7 +18,7 @@ module Reactive.Banana.Frameworks (
     -- ** Core functions
     compile, MomentIO,
     module Control.Event.Handler,
-    fromAddHandler, fromChanges, fromPoll,
+    fromAddHandler, fromChanges, fromPoll, fromPull,
     reactimate, Future, reactimate',
     changes,
     -- $changes
@@ -185,6 +185,9 @@ fromAddHandler = MIO . fmap E . Prim.fromAddHandler
 fromPoll :: IO a -> MomentIO (Behavior a)
 fromPoll = MIO . fmap B . Prim.fromPoll
 
+fromPull :: IO a -> MomentIO (Behavior a)
+fromPull = MIO . fmap B . Prim.fromPull
+
 -- | Input,
 -- obtain a 'Behavior' from an 'AddHandler' that notifies changes.
 --

reactive-banana/src/Reactive/Banana/Internal/Combinators.hs

@@ -2,6 +2,7 @@
     reactive-banana
 ------------------------------------------------------------------------------}
 {-# LANGUAGE RecursiveDo, FlexibleInstances, NoMonomorphismRestriction #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Reactive.Banana.Internal.Combinators where
 
 import           Control.Concurrent.MVar
@@ -16,6 +17,8 @@ import           Data.Functor.Identity
 import           Data.IORef
 import qualified Reactive.Banana.Prim        as Prim
 import           Reactive.Banana.Prim.Cached
+import           Reactive.Banana.Prim.Types (EvalP, _evalP)
+import           Reactive.Banana.Prim.Plumbing (newLatchIO, alwaysP)
 
 type Build   = Prim.Build
 type Latch a = Prim.Latch a
@@ -100,6 +103,16 @@ fromPoll poll = do
         return $ Prim.fromPure p
     stepperB a e
 
+-- | Like fromPoll, but the IO is run only when the value of the Behavior is
+--   demanded.
+--
+--   FIXME it should only run the action at most once per evaluation cycle.
+fromPull :: forall a . IO a -> Moment (Behavior a)
+fromPull pull = cacheAndSchedule $ liftBuild $ do
+    latch <- newLatchIO pull
+    pulse <- alwaysP
+    pure (latch, pulse)
+
 liftIONow :: IO a -> Moment a
 liftIONow = liftIO
 

reactive-banana/src/Reactive/Banana/Prim/Plumbing.hs

@@ -96,6 +96,34 @@ newLatch a = mdo
 
     return (updateOn, latch)
 
+-- | Make a new 'Latch' which runs an IO whenever it is checked.
+--   FIXME Please review this. Ideally the IO would run at most once per
+--   cycle.
+newLatchIO :: IO a -> Build (Latch a)
+newLatchIO ioa = mdo
+    a <- liftIO ioa
+    latch <- liftIO $ newRef $ Latch
+        { _seenL  = beginning
+        , _valueL = a
+        , _evalL  = do
+            Latch {..} <- readRef latch
+            RW.tell _seenL
+            a <- liftIO ioa
+            modify' latch (\x -> x { _valueL = a })
+            pure a
+        }
+    w <- liftIO $ mkWeakRefValue latch latch
+    lw <- liftIO $ newRef $ LatchWrite
+        { _evalLW = do
+            Latch {..} <- readRef latch
+            pure _valueL
+        , _latchLW = w
+        }
+    _ <- liftIO $ mkWeakRefValue latch lw
+    always <- alwaysP
+    (P always) `addChild` (L lw)
+    pure latch
+
 -- | Make a new 'Latch' that caches a previous computation.
 cachedLatch :: EvalL a -> Latch a
 cachedLatch eval = unsafePerformIO $ mdo