Behavior.hs

{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  FRP.Reactive.Behavior
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Reactive behaviors (continuous time)
----------------------------------------------------------------------

module FRP.Reactive.Behavior
  (
    BehaviorG, Behavior
  , time
  , stepper, switcher --, select
  , snapshotWith, snapshot, snapshot_
  , accumB
  , scanlB, monoidB, maybeB, flipFlop, countB
  , sumB, integral
  ) where

import Data.Monoid (Monoid)
import Control.Applicative (Applicative,pure,(<$>))

import Data.VectorSpace

import qualified FRP.Reactive.Reactive as R
import FRP.Reactive.Reactive (TimeT, ITime, Event, withTimeE, diffE)
import FRP.Reactive.Fun
import FRP.Reactive.Internal.Behavior


-- | Time-specialized behaviors.
-- Note: The signatures of all of the behavior functions can be generalized.  Is
-- the interface generality worth the complexity?
type Behavior = BehaviorG ITime TimeT

-- | The identity generalized behavior.  Has value @t@ at time @t@.
time :: Behavior TimeT
time = beh (pure (fun id))

-- Turn a reactive value into a discretly changing behavior.
rToB :: R.Reactive a -> Behavior a
rToB = beh . fmap pure

-- Then use 'rToB' to promote reactive value functions to behavior
-- functions.

-- | Discretely changing behavior, based on an initial value and a
-- new-value event.
stepper :: a -> Event a -> Behavior a
stepper = (fmap.fmap) rToB R.stepper

-- Suggested by Robin Green:

-- stepper = select pure

-- -- | Use a key event to key into a behaviour-valued function
-- select :: (a -> Behavior b) -> a -> Event a -> Behavior b
-- select f a e = f a `switcher` (f <$> e)

-- Looking for a more descriptive name.

-- | Switch between behaviors.
switcher :: Behavior a -> Event (Behavior a) -> Behavior a
b `switcher` eb = beh (unb b `R.switcher` (unb <$> eb))

-- | Snapshots a behavior whenever an event occurs and combines the values
-- using the combining function passed.
snapshotWith :: (a -> b -> c) -> Event a -> Behavior b -> Event c
snapshotWith h e b = f <$> (withTimeE e `R.snapshot` unb b)
 where
   f ((a,t),tfun) = h a (tfun `apply` t)

-- | Snapshot a behavior whenever an event occurs.  See also 'snapshotWith'.
snapshot :: Event a -> Behavior b -> Event (a,b)
snapshot = snapshotWith (,)

-- Alternative implementations:
--   snapshotWith c e b = uncurry c <$> snapshot e b
--   snapshotWith c = (fmap.fmap.fmap) (uncurry c) snapshot

-- | Like 'snapshot' but discarding event data (often @a@ is '()').
snapshot_ :: Event a -> Behavior b -> Event b
snapshot_ = snapshotWith (flip const)

-- Alternative implementations
-- e `snapshot_` src = snd <$> (e `snapshot` src)
-- snapshot_ = (fmap.fmap.fmap) snd snapshot

-- | Behavior from an initial value and an updater event.  See also
-- 'accumE'.
accumB :: a -> Event (a -> a) -> Behavior a
accumB = (fmap.fmap) rToB R.accumR

-- | Like 'scanl' for behaviors.  See also 'scanlE'.
scanlB :: (a -> b -> a) -> a -> Event b -> Behavior a
scanlB = (fmap.fmap.fmap) rToB R.scanlR

-- | Accumulate values from a monoid-valued event.  Specialization of
-- 'scanlE', using 'mappend' and 'mempty'.  See also 'monoidE'.
monoidB :: Monoid a => Event a -> Behavior a
monoidB = fmap rToB R.monoidR

-- | Like 'sum' for behaviors.
sumB :: VectorSpace v s => Event v -> Behavior v
sumB = fmap rToB R.sumR

-- | Start out blank ('Nothing'), latching onto each new @a@, and blanking
-- on each @b@.  If you just want to latch and not blank, then use
-- 'mempty' for the second event.
maybeB :: Event a -> Event b -> Behavior (Maybe a)
maybeB = (fmap.fmap) rToB R.maybeR

-- | Flip-flopping behavior.  Turns true whenever first event occurs and
-- false whenever the second event occurs.
flipFlop :: Event a -> Event b -> Behavior Bool
flipFlop = (fmap.fmap) rToB R.flipFlop

-- | Count occurrences of an event.  See also 'countE'.
countB :: Num n => Event a -> Behavior n
countB = fmap rToB R.countR

-- | Euler integral.
integral :: VectorSpace v TimeT =>
            Event () -> Behavior v -> Behavior v
integral t = sumB . snapshotWith (*^) (diffE (t `snapshot_` time))

-- TODO: find out whether this integral works recursively.  If not, then
-- fix the implementation, rather than changing the semantics.  (No
-- "delayed integral".)
-- 
-- Early experiments suggest that recursive integration gets stuck.
-- Investigate.