Problems with filterMP

[pierre]

This sample code generates rather strange results:

import FRP.Reactive as R
import FRP.Reactive.LegacyAdapters
    
import Control.Applicative

import Control.Monad
import Data.Monoid
import Control.Concurrent
import System.IO

main = do
  c <- makeClock 
  (onStanza, snk_onS) <- makeEvent c
  let bred = ((const $ putStrLn ">10") <$> filterMP (>10) onStanza) `mappend`
             ((const $ putStrLn "<10") <$> filterMP (<10) onStanza)
  hSetBuffering stdout NoBuffering
  doSched c connect bred
  mapM (\x -> snk_onS x >> threadDelay 1000) [5..15]
  forever $ threadDelay 1000000000
  return ()

doSched clock init act = do
  updater <- mkUpdater (cGetTime clock) (stepper init act)
  forkIO $ forever $ (updater)

After displaying:

<10
<10

everything hangs. Debugging shows that sink and updater are called, but updater does nothing.

Same code without filterMP works as expected: it displays 20 messages.

[pierre]

Sorry, there's a typo: "doSched c connect bred" should actually be "doSched c (return ()) bred".

[conal]

I've simplified the example and run a few more experiments

{-# OPTIONS_GHC -Wall #-}
import FRP.Reactive
import FRP.Reactive.LegacyAdapters
    
import Control.Applicative

import Control.Monad
import Data.Monoid
import Control.Concurrent
import System.IO

main :: IO ()


main = mainG mkE1 filt1

type MkETy  = Clock TimeT -> IO (Event Int)
type FiltTy = Event Int -> Event Action -> Event Action

mainG :: MkETy -> FiltTy -> Action
mainG mkE filt = do
  c <- makeClock 
  onStanza <- mkE c
  (never,_) <- makeEvent c
  hSetBuffering stdout NoBuffering
  adaptE (filt onStanza never)


-- Ideally, we get all the way to 15 with each mkE and each filt

-- Results:

--  mkE1:
--    filt1: to 14, then "Future mempty: ..."
--    filt2: none , then "Future mempty: ..."
--    filt3: to 15, then "Future mempty: ..."
--    filt4: to 15, then "Future mempty: ..."

--  mkE2:
--    filt1: to 14
--    filt2: nothing
--    filt3: to 15
--    filt4: to 15


-- Up to the next-to-last one.
filt1,filt2,filt3,filt4 :: FiltTy

filt1 onStanza _ =
  ((putStrLn . (++ " is odd" ) . show) <$> filterE odd onStanza) `mappend`
  ((putStrLn . (++ " is even") . show) <$> filterE (not . odd) onStanza)

-- Nothing at all gets through this one.
filt2 onStanza _ =
  ((putStrLn . show) <$> filterE (const True ) onStanza) `mappend`
  (error "yoink!   " <$> filterE (const False) onStanza)


-- all the way
filt3 onStanza _ =
  (putStrLn . show) <$> filterE (const True) onStanza

-- This one also gets to the end.  I'm surprised.
filt4 onStanza never =
  ((putStrLn . show) <$> filterE (const True) onStanza) `mappend`
  never


mkE1 :: MkETy
mkE1 _ = return (listE ([0,0.1..] `zip` [5 :: Int .. 15]))

mkE2 :: Clock TimeT -> IO (Event Int)
mkE2 c = do 
  (onStanza, snk_onS) <- makeEvent c
  mapM (\x -> snk_onS x >> threadDelay 100) [5 :: Int .. 15]
  return onStanza

[conal]

oops -- please ignore the redundant & confusing comments above the various filt functions

[conal]

Oops. I added a filterE function, specializing filterMP and joinE, but I forgot the base (infinity) case. Now I'm getting similar but somewhat better results than with filterMP. mkE1 works in all cases. With mkE2, I get the results described above for filterE, but one fewer output for mkE2.

My intention is to diagnosis and fix the problem with filterE, then apply what I learn to fixing joinE, and remove filterE.