timeout.hs

timeout :: MonadWidget t m => (Event t a, Event t a) -> NominalDiffTime -> m (Event t a)
timeout (down, up) time = do
  delayed <- delay time down

  let timedOut = flip pushAlways down $ const $ mdo
        isDown <- hold True (False <$ leftmost [up, delayed])
        return $ gate isDown delayed

  switchHold never timedOut

timeout :: GhcjsBuilder t m => (Event t a, Event t a) -> NominalDiffTime -> m (Event t a)
timeout (down, up) time = do
  delayed <- delay time down
  let gateDelay = do
      isDown <- hold True (False <$ leftmost [up, d])
      return $ gate isDown delayed

  switchHold never $ pushAlways f (const gateDelay)