3

I have a Behavior whose value I want to change based on the occurrence of an Event and the Behavior's current value. In the example below I have two counters that are updated based on whether a boolean behaviour is True or False. As it is this code crashes with a <<loop>> exception, but I'm unsure how to restructure it to work or how else to approach this problem.

{-# LANGUAGE ScopedTypeVariables #-}

import Reactive.Banana
import Reactive.Banana.Frameworks

import Control.Arrow
import Control.Concurrent
import Control.Monad
import Control.Monad.Fix

counter :: Bool -> Event t Int -> Behavior t Bool -> (Behavior t Int, Event t (Bool -> Bool))
counter b input active = (result, whenE ((b/=) <$> active) (fmap (const not) input))
    where result = accumB 0 (fmap (+) evt')
          evt' = whenE ((b==) <$> active) input

alternater :: Event t Int -> Behavior t Bool -> (Behavior t (Bool, (Int, Int)), Event t (Bool -> Bool))
alternater input active = ((,) <$> active <*> ((,) <$> fst t1 <*> fst t2), snd t1 `union` snd t2)
    where t1 = counter True input active
          t2 = counter False input active

main :: IO ()
main = do
    (inputHandler, fireInput) <- newAddHandler
    let network :: forall t . Frameworks t => Moment t ()
        network = do
            eInput <- fromAddHandler inputHandler
            let ui :: Behavior t (Bool, (Int, Int)) -> Moment t (Behavior t (Bool, (Int, Int)))
                ui b = do
                    let (behavior, evt) = alternater eInput (fst <$> b)
                    return $ stepper id (fmap (***id) evt) <*> behavior
            output <- changes =<< mfix ui
            reactimate $ putStrLn . show <$> output
    forkIO $ actuate =<< compile network
    forever $ getLine >>= fireInput . read
shachaf
  • 8,890
  • 1
  • 33
  • 51
merijn
  • 131
  • 2
  • You use `accumB` to calculate `result` so I think `behavior` (inside `ui`) is probably fine. I suspect the problem is `evt`. `evt` also depends on `b`, but there are no delayed, or observable, primitives being used to calculate it. Unfortunately, I haven't the foggiest idea at the moment what you should do to fix it. – Jason Dagit Jul 13 '13 at 23:49
  • Actually, it seems to be `behavior` inside `ui` that is the problem, because when I remove the reference to evt (turning it into `return $ stepper id (fmap (***id) never) <*> behavior`) I still run into <>. – merijn Jul 14 '13 at 00:14
  • Hmm...in that case this might be a bug? The docs say `accumB` is supposed to be observable. Same with `stepper`. – Jason Dagit Jul 14 '13 at 02:19

1 Answers1

1

The exception is correct, you are defining a behavior directly in terms of itself.

alternater .. active = (.. <$> active <*> .. , ..)
ui b = do
    let (behavior, ..) = alternater .. (.. <$> b)
    return $ .. <*> behavior

... mfix ui

This code means that the current value of the result behavior in ui would depend on itself in a circular way.

Recursion always needs a little delay to be well-defined. The most convenient way to do that is to use mutual recursion between an event and a behavior built with stepper or accumB. See also this answer.

Community
  • 1
  • 1
Heinrich Apfelmus
  • 11,034
  • 1
  • 39
  • 67
  • You're right, I tried to simplify my original example and didn't notice that the Bool behavior doesn't have an initial specification anywhere. However, if I change the definition from ui to have `` let delay = stepper True $ (fst <$> b) <@ eInput`` and ``let (behavior, evt) = alternater eInput delay`` then I still get a loop, even though all initial values seem to be specified (the counter using accumB and delay being a stepper), am I missing something? – merijn Jul 14 '13 at 19:02