Add switcher (#17)

* WIP: switcher

* Mouse position and buttons need to be 'hot'

* Extract fixE

* Make key events hot

* Move keepLatest into IsEvent class

* Better switcher example

Author: paf31

bower.json

@@ -25,7 +25,8 @@
     "purescript-prelude": "^3.0.0",
     "purescript-eff": "^3.0.0",
     "purescript-sets": "^3.0.0",
-    "purescript-filterable": "^2.3.0"
+    "purescript-filterable": "^2.3.0",
+    "purescript-nullable": "^3.0.0"
   },
   "devDependencies": {
     "purescript-math": "^2.0.0",

generated-docs/FRP/Behavior.md

@@ -84,6 +84,14 @@ Create a `Behavior` which is updated when an `Event` fires, by providing
 an initial value and a function to combine the current value with a new event
 to create a new value.
 
+#### `switcher`
+
+``` purescript
+switcher :: forall a. Behavior a -> Event (Behavior a) -> Behavior a
+```
+
+Switch `Behavior`s based on an `Event`.
+
 #### `integral`
 
 ``` purescript
@@ -211,7 +219,7 @@ Compute a fixed point
 #### `animate`
 
 ``` purescript
-animate :: forall scene eff. ABehavior Event scene -> (scene -> Eff (frp :: FRP | eff) Unit) -> Eff (frp :: FRP | eff) Unit
+animate :: forall scene eff. ABehavior Event scene -> (scene -> Eff (frp :: FRP | eff) Unit) -> Eff (frp :: FRP | eff) (Eff (frp :: FRP | eff) Unit)
 ```
 
 Animate a `Behavior` by providing a rendering function.

generated-docs/FRP/Behavior/Keyboard.md

@@ -8,4 +8,12 @@ keys :: Behavior (Set Int)
 
 A `Behavior` which reports the keys which are currently pressed.
 
+#### `key`
+
+``` purescript
+key :: Int -> Behavior Boolean
+```
+
+A `Behavior` which reports whether a specific key is currently pressed.
+
 

generated-docs/FRP/Event.md

@@ -1,5 +1,13 @@
 ## Module FRP.Event
 
+#### `fix`
+
+``` purescript
+fix :: forall i o. (Event i -> { input :: Event i, output :: Event o }) -> Event o
+```
+
+Compute a fixed point
+
 #### `fold`
 
 ``` purescript
@@ -38,6 +46,7 @@ Events are consumed by providing a callback using the `subscribe` function.
 ##### Instances
 ``` purescript
 Functor Event
+Filterable Event
 Apply Event
 Applicative Event
 Alt Event
@@ -54,49 +63,84 @@ IsEvent Event
 never :: forall a. Event a
 ```
 
-#### `filter`
+#### `keepLatest`
 
 ``` purescript
-filter :: forall a. (a -> Boolean) -> Event a -> Event a
+keepLatest :: forall a. Event (Event a) -> Event a
 ```
 
-Create an `Event` which only fires when a predicate holds.
+Flatten a nested `Event`, reporting values only from the most recent
+inner `Event`.
 
 #### `subscribe`
 
 ``` purescript
-subscribe :: forall eff a r. Event a -> (a -> Eff (frp :: FRP | eff) r) -> Eff (frp :: FRP | eff) Unit
+subscribe :: forall eff a r. Event a -> (a -> Eff (frp :: FRP | eff) r) -> Eff (frp :: FRP | eff) (Eff (frp :: FRP | eff) Unit)
 ```
 
 Subscribe to an `Event` by providing a callback.
 
-#### `create`
+`subscribe` returns a canceller function.
+
+
+### Re-exported from Data.Filterable:
+
+#### `Filterable`
 
 ``` purescript
-create :: forall eff a. Eff (frp :: FRP | eff) { event :: Event a, push :: a -> Eff (frp :: FRP | eff) Unit }
+class (Functor f) <= Filterable f  where
+  filterMap :: forall a b. (a -> Maybe b) -> f a -> f b
 ```
 
-Create an event and a function which supplies a value to that event.
+`Filterable` represents data structures which can be _partitioned_/_filtered_.
 
+- `partitionMap` - partition a data structure based on an either predicate.
+- `partition` - partition a data structure based on boolean predicate.
+- `filterMap` - map over a data structure and filter based on a maybe.
+- `filter` - filter a data structure based on a boolean.
+
+Laws:
+- `map f ≡ filterMap (Just <<< f)`
+- `filter ≡ filterMap <<< maybeBool`
+- `filterMap p ≡ filter (isJust <<< p)`
+
+Default implementations are provided by the following functions:
+
+- `partitionDefault`
+- `partitionDefaultFilter`
+- `partitionDefaultFilterMap`
+- `filterDefault`
+- `filterDefaultPartition`
+- `filterDefaultPartitionMap`
+
+##### Instances
+``` purescript
+Filterable Array
+Filterable Maybe
+(Monoid m) => Filterable (Either m)
+Filterable List
+(Ord k) => Filterable (Map k)
+```
 
 ### Re-exported from FRP.Event.Class:
 
 #### `IsEvent`
 
 ``` purescript
-class (Alternative event) <= IsEvent event  where
+class (Alternative event, Filterable event) <= IsEvent event  where
   fold :: forall a b. (a -> b -> b) -> event a -> b -> event b
-  mapMaybe :: forall a b. (a -> Maybe b) -> event a -> event b
   sampleOn :: forall a b. event a -> event (a -> b) -> event b
+  fix :: forall i o. (event i -> { input :: event i, output :: event o }) -> event o
 ```
 
 Functions which an `Event` type should implement, so that
 `Behavior`s can be defined in terms of any such event type:
 
 - `fold`: combines incoming values using the specified function,
 starting with the specific initial value.
-- `mapMaybe`: discards incoming values which do not satisfy a predicate.
 - `sampleOn`: samples an event at the times when a second event fires.
+- `fix`: compute a fixed point, by feeding output events back in as
+inputs.
 
 #### `withLast`
 

generated-docs/FRP/Event/Class.md

@@ -3,19 +3,20 @@
 #### `IsEvent`
 
 ``` purescript
-class (Alternative event) <= IsEvent event  where
+class (Alternative event, Filterable event) <= IsEvent event  where
   fold :: forall a b. (a -> b -> b) -> event a -> b -> event b
-  mapMaybe :: forall a b. (a -> Maybe b) -> event a -> event b
   sampleOn :: forall a b. event a -> event (a -> b) -> event b
+  fix :: forall i o. (event i -> { input :: event i, output :: event o }) -> event o
 ```
 
 Functions which an `Event` type should implement, so that
 `Behavior`s can be defined in terms of any such event type:
 
 - `fold`: combines incoming values using the specified function,
 starting with the specific initial value.
-- `mapMaybe`: discards incoming values which do not satisfy a predicate.
 - `sampleOn`: samples an event at the times when a second event fires.
+- `fix`: compute a fixed point, by feeding output events back in as
+inputs.
 
 #### `folded`
 
@@ -66,3 +67,42 @@ at the times when the second event fires, ignoring the values produced by
 the second event.
 
 
+### Re-exported from Data.Filterable:
+
+#### `Filterable`
+
+``` purescript
+class (Functor f) <= Filterable f  where
+  filterMap :: forall a b. (a -> Maybe b) -> f a -> f b
+```
+
+`Filterable` represents data structures which can be _partitioned_/_filtered_.
+
+- `partitionMap` - partition a data structure based on an either predicate.
+- `partition` - partition a data structure based on boolean predicate.
+- `filterMap` - map over a data structure and filter based on a maybe.
+- `filter` - filter a data structure based on a boolean.
+
+Laws:
+- `map f ≡ filterMap (Just <<< f)`
+- `filter ≡ filterMap <<< maybeBool`
+- `filterMap p ≡ filter (isJust <<< p)`
+
+Default implementations are provided by the following functions:
+
+- `partitionDefault`
+- `partitionDefaultFilter`
+- `partitionDefaultFilterMap`
+- `filterDefault`
+- `filterDefaultPartition`
+- `filterDefaultPartitionMap`
+
+##### Instances
+``` purescript
+Filterable Array
+Filterable Maybe
+(Monoid m) => Filterable (Either m)
+Filterable List
+(Ord k) => Filterable (Map k)
+```
+

generated-docs/FRP/Event/Keyboard.md

@@ -16,4 +16,12 @@ up :: Event Int
 
 Create an `Event` which fires when a key is released
 
+#### `withKeys`
+
+``` purescript
+withKeys :: forall a. Event a -> Event { value :: a, keys :: Array Int }
+```
+
+Create an event which also returns the current pressed keycodes.
+
 

generated-docs/FRP/Event/Mouse.md

@@ -24,4 +24,20 @@ up :: Event Int
 
 Create an `Event` which fires when a mouse button is released
 
+#### `withPosition`
+
+``` purescript
+withPosition :: forall a. Event a -> Event { value :: a, pos :: Nullable { x :: Int, y :: Int } }
+```
+
+Create an event which also returns the current mouse position.
+
+#### `withButtons`
+
+``` purescript
+withButtons :: forall a. Event a -> Event { value :: a, buttons :: Array Int }
+```
+
+Create an event which also returns the current mouse buttons.
+
 

generated-docs/FRP/Event/Semantic.md

@@ -118,6 +118,7 @@ Functor (Semantic time)
 (Bounded time) => Alternative (Semantic time)
 (Ord time, Semigroup a) => Semigroup (Semantic time a)
 (Bounded time, Monoid a) => Monoid (Semantic time a)
+Filterable (Semantic time)
 (Bounded time) => IsEvent (Semantic time)
 ```
 

src/FRP/Behavior.purs

@@ -9,6 +9,7 @@ module FRP.Behavior
   , gate
   , gateBy
   , unfold
+  , switcher
   , integral
   , integral'
   , derivative
@@ -26,14 +27,13 @@ import Prelude
 import Control.Alt (alt)
 import Control.Apply (lift2)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Unsafe (unsafePerformEff)
 import Data.Filterable (filtered)
 import Data.Function (applyFlipped)
 import Data.Maybe (Maybe(..))
 import Data.Monoid (class Monoid, mempty)
 import Data.Tuple (Tuple(Tuple))
 import FRP (FRP)
-import FRP.Event (class IsEvent, Event, create, fold, sampleOn, subscribe, withLast)
+import FRP.Event (class IsEvent, Event, fix, fold, keepLatest, sampleOn, subscribe, withLast)
 import FRP.Event.Time (animationFrame)
 
 -- | `ABehavior` is the more general type of `Behavior`, which is parameterized
@@ -92,6 +92,11 @@ sampleBy f b e = sample (map f b) (map applyFlipped e)
 sample_ :: forall event a b. IsEvent event => ABehavior event a -> event b -> event a
 sample_ = sampleBy const
 
+-- | Switch `Behavior`s based on an `Event`.
+switcher :: forall a. Behavior a -> Event (Behavior a) -> Behavior a
+switcher b0 e = behavior \s ->
+  keepLatest (pure (sample b0 s) `alt` map (\b -> sample b s) e)
+
 -- | Sample a `Behavior` on some `Event` by providing a predicate function.
 gateBy :: forall event p a. IsEvent event => (p -> a -> Boolean) -> ABehavior event p -> event a -> event a
 gateBy f ps xs = filtered (sampleBy (\p x -> if f p x then Just x else Nothing) ps xs)
@@ -189,11 +194,11 @@ derivative' = derivative (_ $ id)
 
 -- | Compute a fixed point
 fixB :: forall a. a -> (ABehavior Event a -> ABehavior Event a) -> ABehavior Event a
-fixB a f = behavior \s -> unsafePerformEff do
-  { event, push } <- create
-  let b = f (step a event)
-  subscribe (sample_ b s) push
-  pure (sampleOn event s)
+fixB a f =
+  behavior \s ->
+    fix \event ->
+      let b = f (step a event)
+      in { input: sample_ b s, output: sampleOn event s }
 
 -- | Solve a first order differential equation of the form
 -- |
@@ -280,5 +285,5 @@ animate
   :: forall scene eff
    . ABehavior Event scene
   -> (scene -> Eff (frp :: FRP | eff) Unit)
-  -> Eff (frp :: FRP | eff) Unit
+  -> Eff (frp :: FRP | eff) (Eff (frp :: FRP | eff) Unit)
 animate scene render = subscribe (sample_ scene animationFrame) render

src/FRP/Behavior/Keyboard.purs

@@ -1,14 +1,18 @@
 module FRP.Behavior.Keyboard
   ( keys
+  , key
   ) where
 
 import Prelude
 
-import Control.Alt ((<|>))
 import Data.Set as Set
-import FRP.Behavior (Behavior, unfold)
-import FRP.Event.Keyboard (up, down)
+import FRP.Behavior (Behavior, behavior)
+import FRP.Event.Keyboard (withKeys)
 
 -- | A `Behavior` which reports the keys which are currently pressed.
 keys :: Behavior (Set.Set Int)
-keys = unfold id (Set.insert <$> down <|> Set.delete <$> up) Set.empty
+keys = behavior \e -> map (\{ value, keys: ks } -> value (Set.fromFoldable ks)) (withKeys e)
+
+-- | A `Behavior` which reports whether a specific key is currently pressed.
+key :: Int -> Behavior Boolean
+key k = Set.member k <$> keys