Snapshotting a Behavior built with accumB seems to go wrong

[EyalLotem]

You can replace:

                            doesntWork ui
                            --works ui

with snap, and it will still not work, but "works ui" will work. This demonstrates the problem is with snapshotting the behavior.

The code builds a behavior by accumulating all of the keyboard events (into a string in this example, for simplicity's sake. In my real code, I actually capture Up/Down events and build a Set of pressed keys). This Behavior seems to be fine, however, snapshotting it against a regular ticker seems to fail completely.

Here is the code:

{-# OPTIONS -fglasgow-exts -Wall #-}

module Main where

import Control.Applicative
import qualified FRP.Reactive as R
import qualified Graphics.FieldTrip as FT
import Graphics.FieldTrip((*%))
import qualified FRP.Reactive.FieldTrip.Adapter as FieldTripA
import qualified FRP.Reactive.GLUT.Adapter as GLUTA

keysPressed :: GLUTA.UI -> R.Behavior String
keysPressed ui = R.accumB "" (setAction <$> GLUTA.keyPressed ui)
    where
      setAction = (++) . (++" ") . show

main :: IO ()
main = do
  let ticker = R.atTimes [0,0.15..]
      incTicker = R.accumE 0 ((+1) <$ ticker) :: R.Event Integer
      snap ui = R.stepper "" $ incTicker `R.snapshot_` keysPressed ui
      works ui = keysPressed ui
      doesntWork ui = liftA2 (,) (works ui) (snap ui)
  FieldTripA.anim3 $ \ui -> ((FT.uscale3 (0.2::Double) *%) . FT.flatG . FT.utext . show) <$>
                            doesntWork ui
                            --works ui

[EyalLotem]

This bug seems duplicate to #14.

lilac's alternative implementation of snapshotWith resolves this issue, but converts it for a potential space leak.

This patch is lilac's diff:

diff -rN -u old-reactive/src/FRP/Reactive/PrimReactive.hs new-reactive/src/FRP/Reactive/PrimReactive.hs
--- old-reactive/src/FRP/Reactive/PrimReactive.hs	2008-12-02 02:25:32.000000000 +0200
+++ new-reactive/src/FRP/Reactive/PrimReactive.hs	2008-12-02 02:25:32.000000000 +0200
@@ -437,25 +437,43 @@
 
 -- This variant of 'snapshot' has 'Nothing's where @b@ changed and @a@
 -- didn't.
-snap :: forall a b t. Ord t =>
-        EventG t a -> ReactiveG t b -> EventG t (Maybe a, b)
-Event (Future (Max MaxBound, _)) `snap` _ = mempty
-ea `snap` (b0 `Stepper` eb) =
-  (Nothing, b0) `accumE` (fmap fa ea `mappend` fmap fb eb)
- where
-   fa :: a -> Unop (Maybe a, b)
-   fb :: b -> Unop (Maybe a, b)
-   fa a (_,b) = (Just a , b)
-   fb b _     = (Nothing, b)
+-- snap :: forall a b t. Ord t =>
+--         EventG t a -> ReactiveG t b -> EventG t (Maybe a, b)
+-- Event (Future (Max MaxBound, _)) `snap` _ = mempty
+-- ea `snap` (b0 `Stepper` eb) =
+--   (Nothing, b0) `accumE` (fmap fa ea `mappend` fmap fb eb)
+--  where
+--    fa :: a -> Unop (Maybe a, b)
+--    fb :: b -> Unop (Maybe a, b)
+--    fa a (_,b) = (Just a , b)
+--    fb b _     = (Nothing, b)
 
 -- | Snapshot a reactive value whenever an event occurs and apply a
 -- combining function to the event and reactive's values.
-snapshotWith :: Ord t =>
+
+-- snapshotWith :: Ord t =>
+--                 (a -> b -> c) -> EventG t a -> ReactiveG t b -> EventG t c
+-- snapshotWith f e r = joinMaybes $ fmap h (e `snap` r)
+--  where
+--    h (Nothing,_) = Nothing
+--    h (Just a ,b) = Just (f a b)
+
+-------------------------------------
+-- Eyal's change: Using lilac's implementation here:
+snapshotWith :: forall a b c t. Ord t =>
                 (a -> b -> c) -> EventG t a -> ReactiveG t b -> EventG t c
-snapshotWith f e r = joinMaybes $ fmap h (e `snap` r)
+snapshotWith f (Event (Future (t, ~(v `Stepper` es)))) r =
+  (Event (Future (t, f v w `Stepper` es')))
  where
-   h (Nothing,_) = Nothing
-   h (Just a ,b) = Just (f a b)
+   r'@(w `Stepper` _) = skipToR t r
+   es' = snapshotWith f es r'
+
+skipToR :: Ord t => Time t -> ReactiveG t b -> ReactiveG t b
+skipToR t r@(_ `Stepper` Event (Future (t', r')))
+  | t' <= t   = skipToR t r'
+  | otherwise = r
+-------------------------------------
+
 
 -- | Accumulating event, starting from an initial value and a
 -- update-function event.  See also 'accumR'.

The problem is that if the event occurs slowly (or never), this will continue to hold a reference to "r" (even though we're going to be skipping all of r's initial elements).

[EyalLotem]

Follow #14 instead.

[EyalLotem]

testing a diff file