Add gateBy and gate to FRP.Event.Time (#21)

* Add `gateBy` and `gate` to `FRP.Event.Time`

Previously, the functions only existed for `Behavior`. This PR adds them
to `Event` as well.

* Fix comments from review

Put the functions in the wrong place. Oops. This commit moves the
`gate`-related functions from `FRP.Event.Time` to `FRP.Event.Class`, and
exports them.

* Final review changes, merging in blocking

As per the other PR, I've combined these two because there's some
interdependence. This implements the mentioned changes, and should now
be up-to-date with both PRs.

* Replace "initial gating value" with `Maybe`

Previously, the function required an initial value. This wasn't great if
you didn't have such a value to hand, and has hence been removed in
favour of a `Maybe` in the predicate. The result is much neater :)

Author: Tom Harding

src/FRP/Event/Class.purs

@@ -9,14 +9,16 @@ module FRP.Event.Class
   , sampleOn_
   , keepLatest
   , fix
+  , gate
+  , gateBy
   , module Data.Filterable
   ) where
 
 import Prelude
 
-import Control.Alternative (class Alternative)
-import Data.Filterable (class Filterable, filterMap)
-import Data.Maybe (Maybe(..))
+import Control.Alternative (class Alternative, (<|>))
+import Data.Filterable (class Filterable, filterMap, filtered)
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Monoid (class Monoid, mempty)
 import Data.Tuple (Tuple(..), snd)
 
@@ -67,3 +69,24 @@ mapAccum f xs acc = filterMap snd
 -- | the second event.
 sampleOn_ :: forall event a b. IsEvent event => event a -> event b -> event a
 sampleOn_ a b = sampleOn a (b $> id)
+
+-- | Sample the events that are fired while a boolean event is true. Note that,
+-- | until the boolean event fires, it will be assumed to be `false`, and events
+-- | will be blocked.
+gate :: forall a event. IsEvent event => event Boolean -> event a -> event a
+gate = gateBy (\x _ -> fromMaybe false x)
+
+-- | Generalised form of `gateBy`, allowing for any predicate between the two
+-- | events. Until a value from the first event is received, `Nothing` will be
+-- | passed to the predicate.
+gateBy
+  :: forall a b event
+   . IsEvent event
+  => (Maybe a -> b -> Boolean)
+  -> event a
+  -> event b
+  -> event b
+gateBy f sampled
+   = filtered
+ <<< sampleOn (pure Nothing <|> (Just <$> sampled))
+ <<< map \x p -> if f p x then Just x else Nothing

src/FRP/Event/Time.purs

@@ -4,8 +4,11 @@ module FRP.Event.Time
   , withTime
   ) where
 
+import Data.Maybe (Maybe, maybe)
 import Data.Unit (Unit)
 import FRP.Event (Event)
+import FRP.Event.Class (fix, gateBy)
+import Prelude ((+), (<), map)
 
 -- | Create an event which fires every specified number of milliseconds.
 foreign import interval :: Int -> Event Int
@@ -15,3 +18,38 @@ foreign import animationFrame :: Event Unit
 
 -- | Create an event which reports the current time in milliseconds since the epoch.
 foreign import withTime :: forall a. Event a -> Event { value :: a, time :: Number }
+
+-- | On each event, ignore subsequent events for a given number of milliseconds.
+debounce :: forall a. Number -> Event a -> Event a
+debounce period = debounceWith (map { period, value: _ })
+
+-- | Provided an input event and transformation, block the input event for the
+-- | duration of the specified period on each output.
+debounceWith
+  :: forall a b.
+     (Event a -> Event { period :: Number, value :: b })
+  -> Event a
+  -> Event b
+debounceWith process event
+  = fix \allowed ->
+      let
+        processed :: Event { period :: Number, value :: b }
+        processed = process allowed
+
+        expiries :: Event Number
+        expiries =
+          map (\{ time, value } -> time + value)
+              (withTime (map _.period processed))
+
+        comparison :: forall r. Maybe Number -> { time :: Number | r } -> Boolean
+        comparison a b = maybe true (_ < b.time) a
+
+        unblocked :: Event { time :: Number, value :: a }
+        unblocked = gateBy comparison expiries stamped
+      in
+        { input:  map _.value unblocked
+        , output: map _.value processed
+        }
+  where
+    stamped :: Event { time :: Number, value :: a }
+    stamped = withTime event