Event zip combinator for Reactive Haskell

zipE

import Data.Functor
import Data.Time.Units
import System.Timeout
import Control.Monad
import Control.Concurrent

import FRP.Sodium

main :: IO ()
main = do
    (ev1, push1) <- sync newEvent
    (ev2, push2) <- sync newEvent
    ev  <- sync $ zipE ev1 ev2
    evT <- timeoutE 3000 ev

    unreg <- sync $ listen evT print
    _ <- forkIO $ tick push1 123 1
    _ <- forkIO $ tick push2 666 4
    threadDelay 100000000
    unreg

tick :: (Int -> Reactive ()) -> Int -> Int-> IO ()
tick push n s = do
    pause
    sync $ push n
  where pause = threadDelay . fromInteger $ toMicroseconds (read (show s ++ "s") :: Second)

zipE :: Event a -> Event b -> Reactive (Event (a, b))
zipE evA evB = do
    be <- accum (Nothing, Nothing) (evA' `merge` evB')
    return $ filterJust $ both <$> updates be
  where evA' = (\a (_, b) -> (Just a, b)) <$> evA
        evB' = (\b (a, _) -> (a, Just b)) <$> evB
        both (a, b) = do
            a' <- a
            b' <- b
            return (a', b')

timeoutE :: Int -> Event a -> IO (Event (Maybe a))
timeoutE t ev = do
    (tev, push) <- sync newEvent
    let pipe = join $ sync $ listen ev (sync . push . Just)
    r <- timeout (t * 1000) pipe
    case r of
      Nothing -> sync $ push Nothing >> return tev
      Just () -> return tev