Small program exhibiting strange behavior when merging event streams

Edit: I simplified my problem down to what seems to just be a problem with merge:

I expect the following program to print "Selected x" every time I press one of the keys 1-9 on my keyboard. However, I have to repeatedly press that key in order to get the event event to come through.

import Data.Char
import Control.FRPNow
import Control.Monad
import Data.Traversable
import System.IO

main :: IO ()
main =
  do hSetBuffering stdin NoBuffering
     hSetBuffering stdout NoBuffering
     runNowMaster
       (do items <-
             for [1 .. 9]
                 (\n ->
                    do (presses,press) <- callbackStream
                       _ <-
                         async (forever (getChar >>= press))
                       return (n <$ filterEs (intToDigit n ==) presses))
           callIOStream (putStrLn . ("Selected " ++) . show)
                        (foldl merge mempty items)
           return never)

Below is my original post, for posterity

I've managed to construct a small minimal program here that exhibits some confusing (to me) behavior.

The program models a selector that allows the user to select one of three items. Each item can be constructed with newItemSelector, which yields a rendering of that item, allowing it to indicate whether or not it is selected, and an event stream indicating whenever it is selected. These items are provided with a Behavior Bool to indicate whether or not they are the current selection. Users can select items by pressing 1/2/3 on their keyboard.

In the main loop, I create three possible item selectors, and I simply print out a list of the items whenever they change their rendered representation.

Something odd happens when I run this.

[nix-shell:~/work/scratchpad]$ ./frpnow
["True","False","False"]
22["False","True","False"]
3["False","False","True"]
22["False","True","False"]
11["True","False","False"]
2["False","True","False"]
3["False","False","True"]
22["False","True","False"]

Notice how sometimes I have to select the item multiple times for the change to actually be presented. To highlight one example, note I select '3' with one key press, but then have to press 2 twice in order to trigger that re-rendering.

I can't quite figure out if I'm wrong, on frpnow is wrong. Any ideas?

{-# LANGUAGE RecursiveDo #-}

import Control.Applicative
import Control.FRPNow
import Control.Monad
import Data.Traversable

data Item
  = Item1
  | Item2
  | Item3
  deriving (Bounded,Enum,Eq,Ord,Show)

index :: Item -> Char
index Item1 = '1'
index Item2 = '2'
index Item3 = '3'

main :: IO ()
main =
  do runNowMaster
       (mdo items <-
              for [minBound .. maxBound]
                  (\item ->
                     let active =
                           fmap (item ==) currentState
                     in newItemSelector item active)
            currentState <-
              sample (fromChanges Item1
                                  (foldl merge mempty (fmap snd items)))
            callIOStream print
                         (toChanges (mapM fst items))
            return never)

newItemSelector
  :: Item -> Behavior Bool -> Now (Behavior String,EvStream Item)
newItemSelector item isActive =
  do (presses,press) <- callbackStream
     async (forever (getChar >>= press))
     return (fmap show isActive,item <$ (filterEs (index item ==) presses))

atzeus / FRPNow

Small program exhibiting strange behavior when merging event streams #3