{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Active
-- Copyright   :  (c) 2011 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- Inspired by the work of Kevin Matlage and Andy Gill (/Every/
-- /Animation Should Have a Beginning, a Middle, and an End/, Trends
-- in Functional Programming,
-- 2010. <http://ittc.ku.edu/csdl/fpg/node/46>), this module defines a
-- simple abstraction for working with time-varying values.  A value
-- of type @Active a@ is either a constant value of type @a@, or a
-- time-varying value of type @a@ (/i.e./ a function from time to
-- @a@) with specific start and end times.  Since active values
-- have start and end times, they can be aligned, sequenced,
-- stretched, or reversed.
--
-- In a sense, this is sort of like a stripped-down version of
-- functional reactive programming (FRP), without the reactivity.
--
-- The original motivating use for this library is to support making
-- animations with the diagrams framework
-- (<http://projects.haskell.org/diagrams>), but the hope is that it
-- may find more general utility.
--
-- There are two basic ways to create an @Active@ value.  The first is
-- to use 'mkActive' to create one directly, by specifying a start and
-- end time and a function of time.  More indirectly, one can use the
-- 'Applicative' instance together with the unit interval 'ui', which
-- takes on values from the unit interval from time 0 to time 1, or
-- 'interval', which creates an active over an arbitrary interval.
--
-- For example, to create a value of type @Active Double@ which
-- represents one period of a sine wave starting at time 0 and ending
-- at time 1, we could write
--
-- > mkActive 0 1 (\t -> sin (fromTime t * tau))
--
-- or
--
-- > (sin . (*tau)) <$> ui
--
-- 'pure' can also be used to create @Active@ values which are
-- constant and have no start or end time.  For example,
--
-- > mod <$> (floor <$> interval 0 100) <*> pure 7
--
-- cycles repeatedly through the numbers 0-6.
--
-- Note that the \"idiom bracket\" notation supported by the SHE
-- preprocessor (<http://personal.cis.strath.ac.uk/~conor/pub/she/>,
-- <http://hackage.haskell.org/package/she>) can make for somewhat
-- more readable 'Applicative' code.  For example, the above example
-- can be rewritten using SHE as
--
-- > {-# OPTIONS_GHC -F -pgmF she #-}
-- >
-- > ... (| mod (| floor (interval 0 100) |) ~7 |)
--
-- There are many functions for transforming and composing active
-- values; see the documentation below for more details.
--
--
-- With careful handling, this module should be suitable to generating
-- deep embeddings if 'Active' values.
--
-----------------------------------------------------------------------------

module Data.Active
       ( -- * Representing time

         -- ** Time and duration

         Time, Clock(..)
       , Duration, Waiting(..)

         -- ** Eras

       , Era, mkEra
       , start, end, duration

         -- * Deadlines

       , Deadline(..)

         -- * Dynamic values
       , Dynamic(..), mkDynamic, onDynamic

       , shiftDynamic
       , transitionDeadline

         -- * Active values
         -- $active
       , Active, mkActive, fromDynamic, isConstant, isDynamic

       , onActive, modActive, runActive

       , activeEra, setEra, atTime

       , activeStart, activeEnd

         -- * Combinators

         -- ** Special active values

       , ui, interval

         -- ** Transforming active values

       , stretch, stretchTo, during
       , shift, backwards

       , snapshot

         -- ** Working with values outside the era
       , clamp, clampBefore, clampAfter
       , trim, trimBefore, trimAfter

         -- ** Composing active values

       , after

       , (->>)

       , (|>>), movie

         -- * Deadlines

         , activeDeadline

         -- * Discretization

       , discrete
       , simulate

         -- * Fractionals

       , FractionalOf(..)

       ) where

import           Control.Applicative
import           Control.Arrow       ((&&&))
import           Control.Newtype

import           Data.Array

import           Data.Functor.Apply
import           Data.Semigroup      hiding (First (..))

import           Data.AffineSpace
import           Data.VectorSpace    hiding ((<.>))

------------------------------------------------------------
-- Clock
------------------------------------------------------------
-- | A class that abstracts over time.

class ( AffineSpace t
      , Waiting (Diff t)
      ) => Clock t where

  -- | Convert any value of a 'Real' type (including @Int@, @Integer@,
  --   @Rational@, @Float@, and @Double@) to a 'Time'.
  toTime :: Real a => a -> t
  -- | Convert a 'Time' to a value of any 'Fractional' type (such as
  --   @Rational@, @Float@, or @Double@).
  fromTime :: (FractionalOf t a) => t -> a

  firstTime :: t -> t -> t
  lastTime  :: t -> t -> t

class (FractionalOf w (Scalar w), VectorSpace w) => Waiting w where
  -- | Convert any value of a 'Real' type (including @Int@, @Integer@,
  --   @Rational@, @Float@, and @Double@) to a 'Duration'.
  toDuration :: Real a => a -> w

  -- | Convert a 'Duration' to any other 'Fractional' type (such as
  --   @Rational@, @Float@, or @Double@).
  fromDuration :: (FractionalOf w a) => w -> a

class Fractional a => FractionalOf v a where
        toFractionalOf :: v -> a

class Clock t => Deadline t a where
        -- choose time-now deadline-time (if before / at deadline) (if after deadline)
        choose :: t -> t -> a -> a -> a

------------------------------------------------------------
-- Time
------------------------------------------------------------

-- | An abstract type for representing /points in time/.  Note that
--   literal numeric values may be used as @Time@s, thanks to the the
--   'Num' and 'Fractional' instances.  'toTime' and 'fromTime' are
--   also provided for convenience in converting between @Time@ and
--   other numeric types.
newtype Time = Time { unTime :: Rational }
  deriving ( Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac )

instance Newtype Time Rational where
  pack   = Time
  unpack = unTime

instance AffineSpace Time where
  type Diff Time = Duration
  (Time t1) .-. (Time t2) = Duration (t1 - t2)
  (Time t) .+^ (Duration d) = Time (t + d)

instance Clock Time where
  toTime = fromRational . toRational
  fromTime = fromRational . unTime
  firstTime = min
  lastTime = max

instance Fractional a => FractionalOf Time a where
  toFractionalOf (Time d) = fromRational d

instance Deadline Time a where
        -- choose tm deadline (if before / at deadline) (if after deadline)
        choose t1 t2 a b = if t1 <= t2 then a else b

-- | An abstract type representing /elapsed time/ between two points
--   in time.  Note that durations can be negative. Literal numeric
--   values may be used as @Duration@s thanks to the 'Num' and
--   'Fractional' instances. 'toDuration' and 'fromDuration' are also
--   provided for convenience in converting between @Duration@s and
--   other numeric types.
newtype Duration = Duration { unDuration :: Rational }
  deriving ( Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac
           , AdditiveGroup)

instance Newtype Duration Rational where
  pack   = Duration
  unpack = unDuration

instance VectorSpace Duration where
  type Scalar Duration = Rational
  s *^ (Duration d) = Duration (s * d)

instance Waiting Duration where
  toDuration = fromRational . toRational
  fromDuration = toFractionalOf

instance Fractional a => FractionalOf Duration a where
  toFractionalOf (Duration d) = fromRational d

-- | An @Era@ is a concrete span of time, that is, a pair of times
--   representing the start and end of the era. @Era@s form a
--   semigroup: the combination of two @Era@s is the smallest @Era@
--   which contains both.  They do not form a 'Monoid', since there is
--   no @Era@ which acts as the identity with respect to this
--   combining operation.
--
--   @Era@ is abstract. To construct @Era@ values, use 'mkEra'; to
--   deconstruct, use 'start' and 'end'.
newtype Era t = Era (Min t, Max t)
  deriving (Show)

-- AJG: I explicitly implement this to make sure we use min and max,
-- and not compare (which does not reify into a deep embedded structure).
instance Clock t => Semigroup (Era t) where
  Era (Min min1,Max max1) <> Era (Min min2,Max max2)
    = Era (Min (firstTime min1 min2),Max (lastTime max1 max2))

-- | Create an 'Era' by specifying start and end 'Time's.
mkEra :: t -> t -> Era t
mkEra s e = Era (Min s, Max e)

-- | Get the start 'Time' of an 'Era'.
start :: Era t -> t
start (Era (Min t, _)) = t

-- | Get the end 'Time' of an 'Era'.
end :: Era t -> t
end (Era (_, Max t)) = t

-- | Compute the 'Duration' of an 'Era'.
duration :: (Clock t) => Era t -> Diff t
duration = (.-.) <$> end <*> start

------------------------------------------------------------
-- Dynamic
------------------------------------------------------------

-- | A @Dynamic a@ can be thought of as an @a@ value that changes over
--   the course of a particular 'Era'.  It's envisioned that @Dynamic@
--   will be mostly an internal implementation detail and that
--   'Active' will be most commonly used.  But you never know what
--   uses people might find for things.

data Dynamic t a = Dynamic { era        :: Era t
                           , runDynamic :: t -> a
                           }
  deriving (Functor)

-- | 'Dynamic' is an instance of 'Apply' (/i.e./ 'Applicative' without
--   'pure'): a time-varying function is applied to a time-varying
--   value pointwise; the era of the result is the combination of the
--   function and value eras.  Note, however, that 'Dynamic' is /not/
--   an instance of 'Applicative' since there is no way to implement
--   'pure': the era would have to be empty, but there is no such
--   thing as an empty era (that is, 'Era' is not an instance of
--   'Monoid').

instance (Clock t) => Apply (Dynamic t) where
  (Dynamic d1 f1) <.> (Dynamic d2 f2) = Dynamic (d1 <> d2) (f1 <.> f2)

-- | @'Dynamic' a@ is a 'Semigroup' whenever @a@ is: the eras are
--   combined according to their semigroup structure, and the values
--   of type @a@ are combined pointwise.  Note that @'Dynamic' a@ cannot
--   be an instance of 'Monoid' since 'Era' is not.
instance (Clock t, Semigroup a) => Semigroup (Dynamic t a) where
  Dynamic d1 f1 <> Dynamic d2 f2 = Dynamic (d1 <> d2) (f1 <> f2)

-- | Create a 'Dynamic' from a start time, an end time, and a
--   time-varying value.
mkDynamic :: t -> t -> (t -> a) -> Dynamic t a
mkDynamic s e = Dynamic (mkEra s e)

-- | Fold for 'Dynamic'.
onDynamic :: (t -> t -> (t -> a) -> b) -> Dynamic t a -> b
onDynamic f (Dynamic e d) = f (start e) (end e) d

-- | Shift a 'Dynamic' value by a certain duration.
shiftDynamic :: (Clock t) => Diff t -> Dynamic t a -> Dynamic t a
shiftDynamic sh =
  onDynamic $ \s e d ->
    mkDynamic
      (s .+^ sh)
      (e .+^ sh)
      (\t -> d (t .-^ sh))

-- | take the first value until a deadline, then take the second value, inside a Dynamic.
transitionDeadline :: Deadline t a => t -> Dynamic t (a -> a -> a)
transitionDeadline dl = mkDynamic dl dl (\ t -> choose t dl)

------------------------------------------------------------
--  Active
------------------------------------------------------------

-- $active
-- For working with time-varying values, it is convenient to have an
-- 'Applicative' instance: '<*>' lets us apply time-varying
-- functions to time-varying values; 'pure' allows treating constants
-- as time-varying values which do not vary.  However, as explained in
-- its documentation, 'Dynamic' cannot be made an instance of
-- 'Applicative' since there is no way to implement 'pure'.  The
-- problem is that all 'Dynamic' values must have a finite start and
-- end time.  The solution is to adjoin a special constructor for
-- pure/constant values with no start or end time, giving us 'Active'.

-- | There are two types of @Active@ values:
--
--   * An 'Active' can simply be a 'Dynamic', that is, a time-varying
--     value with start and end times.
--
--   * An 'Active' value can also be a constant: a single value,
--     constant across time, with no start and end times.
--
--   The addition of constant values enable 'Monoid' and 'Applicative'
--   instances for 'Active'.
newtype Active t a = Active (MaybeApply (Dynamic t) a)
  deriving (Functor, Apply, Applicative)

instance Newtype (Active t a) (MaybeApply (Dynamic t) a) where
  pack              = Active
  unpack (Active m) = m

instance Newtype (MaybeApply f a) (Either (f a) a) where
  pack   = MaybeApply
  unpack = runMaybeApply

-- | Ideally this would be defined in the @newtype@ package.  If it is
--   ever added we can remove it from here.
over2 :: (Newtype n o, Newtype n' o', Newtype n'' o'')
      => (o -> n) -> (o -> o' -> o'') -> (n -> n' -> n'')
over2 _ f n1 n2 = pack (f (unpack n1) (unpack n2))

-- | Active values over a type with a 'Semigroup' instance are also an
--   instance of 'Semigroup'.  Two active values are combined
--   pointwise; the resulting value is constant iff both inputs are.
instance (Clock t, Semigroup a) => Semigroup (Active t a) where
  (<>) = (over2 Active . over2 MaybeApply) combine
   where
    combine (Right m1) (Right m2)
      = Right (m1 <> m2)

    combine (Left (Dynamic dur f)) (Right m)
      = Left (Dynamic dur (f <> const m))

    combine (Right m) (Left (Dynamic dur f))
      = Left (Dynamic dur (const m <> f))

    combine (Left d1) (Left d2)
      = Left (d1 <> d2)

instance (Clock t, Monoid a, Semigroup a) => Monoid (Active t a) where
  mempty  = Active (MaybeApply (Right mempty))
  mappend = (<>)

-- | Create an 'Active' value from a 'Dynamic'.
fromDynamic :: Dynamic t a -> Active t a
fromDynamic = Active . MaybeApply . Left

-- | Create a dynamic 'Active' from a start time, an end time, and a
--   time-varying value.
mkActive :: t -> t -> (t -> a) -> Active t a
mkActive s e f = fromDynamic (mkDynamic s e f)

-- | Fold for 'Active's.  Process an 'Active a', given a function to
--   apply if it is a pure (constant) value, and a function to apply if
--   it is a 'Dynamic'.
onActive :: (a -> b) -> (Dynamic t a -> b) -> Active t a -> b
onActive f _ (Active (MaybeApply (Right a))) = f a
onActive _ f (Active (MaybeApply (Left d)))  = f d

-- | Modify an 'Active' value using a case analysis to see whether it
--   is constant or dynamic.
modActive :: (Clock t) => (a -> b) -> (Dynamic t a -> Dynamic t b) -> Active t a -> Active t b
modActive f g = onActive (pure . f) (fromDynamic . g)

-- | Interpret an 'Active' value as a function from time.
runActive :: Active t a -> (t -> a)
runActive = onActive const runDynamic

-- | Get the value of an @Active a@ at the beginning of its era.
activeStart :: Active t a -> a
activeStart = onActive id (onDynamic $ \s _ d -> d s)

-- | Get the value of an @Active a@ at the end of its era.
activeEnd :: Active t a -> a
activeEnd = onActive id (onDynamic $ \_ e d -> d e)

-- | Get the 'Era' of an 'Active' value (or 'Nothing' if it is
--   a constant/pure value).
activeEra :: Active t a -> Maybe (Era t)
activeEra = onActive (const Nothing) (Just . era)

-- | Test whether an 'Active' value is constant.
isConstant :: Active t a -> Bool
isConstant = onActive (const True) (const False)

-- | Test whether an 'Active' value is 'Dynamic'.
isDynamic :: Active t a -> Bool
isDynamic = onActive (const False) (const True)

-- | take the first value until a deadline, then take the second value, inside an 'Active'.
activeDeadline :: Deadline t a => t -> Active t (a -> a -> a)
activeDeadline = fromDynamic . transitionDeadline

------------------------------------------------------------
--  Combinators
------------------------------------------------------------

-- | @ui@ represents the /unit interval/, which takes on the value @t@
--   at time @t@, and has as its era @[0,1]@. It is equivalent to
--   @'interval' 0 1@, and can be visualized as follows:
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/ui.png>>
--
--   On the x-axis is time, and the value that @ui@ takes on is on the
--   y-axis.  The shaded portion represents the era.  Note that the
--   value of @ui@ (as with any active) is still defined outside its
--   era, and this can make a difference when it is combined with
--   other active values with different eras.  Applying a function
--   with 'fmap' affects all values, both inside and outside the era.
--   To manipulate values outside the era specifically, see 'clamp'
--   and 'trim'.
--
--   To alter the /values/ that @ui@ takes on without altering its
--   era, use its 'Functor' and 'Applicative' instances.  For example,
--   @(*2) \<$\> ui@ varies from @0@ to @2@ over the era @[0,1]@.  To
--   alter the era, you can use 'stretch' or 'shift'.
-- TODO: Num=>Clock
ui :: (Clock t, FractionalOf t a) => Active t a
ui = interval (toTime (0 :: Integer)) (toTime (1 :: Integer))

-- | @interval a b@ is an active value starting at time @a@, ending at
--   time @b@, and taking the value @t@ at time @t@.
interval :: (Clock t, FractionalOf t a) => t -> t -> Active t a
interval a b = mkActive a b fromTime

-- | @stretch s act@ \"stretches\" the active @act@ so that it takes
--   @s@ times as long (retaining the same start time).
stretch :: (Clock t) => Rational -> Active t a -> Active t a
stretch 0 = modActive id . onDynamic $ \s _ d -> mkDynamic s s d
stretch str = modActive id . onDynamic $ \s e d ->
    mkDynamic s (s .+^ (fromRational str *^ (e .-. s)))
      (\t -> d (s .+^ ((t .-. s) ^/ fromRational str)))

-- | @stretchTo d@ 'stretch'es an 'Active' so it has duration @d@.
--   Has no effect if (1) @d@ is non-positive, or (2) the 'Active'
--   value is constant, or (3) the 'Active' value has zero duration.
-- [AJG: conditions (1) and (3) no longer true: to consider changing]

stretchTo :: (Deadline t a) => Diff t -> Active t a -> Active t a
stretchTo toD = modActive id . onDynamic $ \s e d ->
    mkDynamic s (s .+^ toD)
        (\ t -> choose (s .+^ toD) s
                     (d s)      -- avoiding dividing by zero
                     (d (s .+^ (((t .-. s) ^/ (fromDuration toD / fromDuration (e .-. s)))))))

-- | @a1 \`during\` a2@ 'stretch'es and 'shift's @a1@ so that it has the
--   same era as @a2@.  Has no effect if either of @a1@ or @a2@ are constant.
during :: (Deadline t a) => Active t a -> Active t a -> Active t a
during a1 a2 = maybe a1 (\(d,s) -> stretchTo d . atTime s $ a1)
                 ((duration &&& start) <$> activeEra a2)

-- | @shift d act@ shifts the start time of @act@ by duration @d@.
--   Has no effect on constant values.
shift :: (Clock t) => Diff t -> Active t a -> Active t a
shift sh = modActive id (shiftDynamic sh)

-- | Reverse an active value so the start of its era gets mapped to
--   the end and vice versa.  For example, @backwards 'ui'@ can be
--   visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/backwards.png>>
backwards :: (Clock t) => Active t a -> Active t a
backwards =
  modActive id . onDynamic $ \s e d ->
    mkDynamic s e
      (\t -> d (s .+^ (e .-. t)))


-- | Take a \"snapshot\" of an active value at a particular time,
--   resulting in a constant value.
snapshot :: (Clock t) => t -> Active t a -> Active t a
snapshot t a = pure (runActive a t)

-- | \"Clamp\" an active value so that it is constant before and after
--   its era.  Before the era, @clamp a@ takes on the value of @a@ at
--   the start of the era.  Likewise, after the era, @clamp a@ takes
--   on the value of @a@ at the end of the era. @clamp@ has no effect
--   on constant values.
--
--   For example, @clamp 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/clamp.png>>
--
--   See also 'clampBefore' and 'clampAfter', which clamp only before
--   or after the era, respectively.

clamp :: Clock t => Active t a -> Active t a
clamp =
  modActive id . onDynamic $ \s e d ->
    mkDynamic s e
      (\t -> d (firstTime (lastTime t s) e))

-- | \"Clamp\" an active value so that it is constant before the start
--   of its era. For example, @clampBefore 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/clampBefore.png>>
--
--   See the documentation of 'clamp' for more information.
clampBefore :: Active t a -> Active t a
clampBefore = undefined

-- | \"Clamp\" an active value so that it is constant after the end
--   of its era.  For example, @clampBefore 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/clampAfter.png>>
--
--   See the documentation of 'clamp' for more information.
clampAfter :: Active t a -> Active t a
clampAfter = undefined

-- | \"Trim\" an active value so that it is empty outside its era.
--   @trim@ has no effect on constant values.
--
--   For example, @trim 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/trim.png>>
--
--   Actually, @trim ui@ is not well-typed, since it is not guaranteed
--   that @ui@'s values will be monoidal (and usually they won't be)!
--   But the above image still provides a good intuitive idea of what
--   @trim@ is doing. To make this precise we could consider something
--   like @trim (First . Just <$> ui)@.
--
--   See also 'trimBefore' and 'trimActive', which trim only before or
--   after the era, respectively.

trim :: (Clock t, Deadline t a, Monoid a) => Active t a -> Active t a
trim =
  modActive id . onDynamic $ \s e d ->
    mkDynamic s e
      (\t -> choose s t (choose t e (d t) mempty) mempty)


-- | \"Trim\" an active value so that it is empty /before/ the start
--   of its era. For example, @trimBefore 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/trimBefore.png>>
--
--   See the documentation of 'trim' for more details.
trimBefore :: (Clock t, Deadline t a, Monoid a) => Active t a -> Active t a
trimBefore =
  modActive id . onDynamic $ \s e d ->
    mkDynamic s e
      (\t -> choose s t (d t) mempty)

-- | \"Trim\" an active value so that it is empty /after/ the end
--   of its era.  For example, @trimAfter 'ui'@ can be visualized as
--
--   <<http://www.cis.upenn.edu/~byorgey/hosted/trimAfter.png>>
--
--   See the documentation of 'trim' for more details.
trimAfter :: (Clock t, Deadline t a, Monoid a) => Active t a -> Active t a
trimAfter =
  modActive id . onDynamic $ \s e d ->
    mkDynamic s e
      (\t -> choose t e (d t) mempty)

-- | Set the era of an 'Active' value.  Note that this will change a
--   constant 'Active' into a dynamic one which happens to have the
--   same value at all times.
setEra :: Era t -> Active t a -> Active t a
setEra er =
  onActive
    (mkActive (start er) (end er) . const)
    (fromDynamic . onDynamic (\_ _ -> mkDynamic (start er) (end er)))

-- | @atTime t a@ is an active value with the same behavior as @a@,
--   shifted so that it starts at time @t@.  If @a@ is constant it is
--   returned unchanged.
atTime :: Clock t => t -> Active t a -> Active t a
atTime t a = maybe a (\e -> shift (t .-. start e) a) (activeEra a)

-- | @a1 \`after\` a2@ produces an active that behaves like @a1@ but is
--   shifted to start at the end time of @a2@.  If either @a1@ or @a2@
--   are constant, @a1@ is returned unchanged.
after :: Clock t => Active t a -> Active t a -> Active t a
after a1 a2 = maybe a1 ((`atTime` a1) . end) (activeEra a2)

infixr 5 ->>


-- XXX illustrate

-- | Sequence/overlay two 'Active' values: shift the second to start
--   immediately after the first (using 'after'), then compose them
--   (using '<>').
(->>) :: (Clock t, Semigroup a) => Active t a -> Active t a -> Active t a
a1 ->> a2 = a1 <> (a2 `after` a1)


-- XXX illustrate

-- | \"Splice\" two 'Active' values together: shift the second to
--   start immediately after the first (using 'after'), and produce
--   the value which acts like the first up to the common end/start
--   point, then like the second after that.  If both are constant,
--   return the first.
(|>>) :: (Deadline t a) => Active t a -> Active t a -> Active t a
a1 |>> a2 = onActive pure (\ d1 ->
                activeDeadline (end (era d1))
                        <.> a1
                        <.> (a2 `after` a1)
          ) a1

-- XXX implement 'movie' with a balanced fold

-- | Splice together a list of active values using '|>>'.  The list
--   must be nonempty.
movie :: (Deadline t a) => [Active t a] -> Active t a
movie = foldr1 (|>>)


------------------------------------------------------------
--  Discretization
------------------------------------------------------------

-- | Create an @Active@ which takes on each value in the given list in
--   turn during the time @[0,1]@, with each value getting an equal
--   amount of time.  In other words, @discrete@ creates a \"slide
--   show\" that starts at time 0 and ends at time 1.  The first
--   element is used prior to time 0, and the last element is used
--   after time 1.
--
--   It is an error to call @discrete@ on the empty list.
discrete :: (Clock t, FractionalOf t Rational) => [a] -> Active t a
discrete [] = error "Data.Active.discrete must be called with a non-empty list."
discrete xs = f <$> ui
  where f (t :: Rational)
            | t <= 0    = arr ! 0
            | t >= 1    = arr ! (n-1)
            | otherwise = arr ! floor (t * fromIntegral n)
        n   = length xs
        arr = listArray (0, n-1) xs

-- | @simulate r act@ simulates the 'Active' value @act@, returning a
--   list of \"snapshots\" taken at regular intervals from the start
--   time to the end time.  The interval used is determined by the
--   rate @r@, which denotes the \"frame rate\", that is, the number
--   of snapshots per unit time.
--
--   If the 'Active' value is constant (and thus has no start or end
--   times), a list of length 1 is returned, containing the constant
--   value.
simulate :: (Clock t, FractionalOf t Rational) => Rational -> Active t a -> [a]
simulate rate =
  onActive (:[])
           (\d -> map (runDynamic d . toTime)
                      (let s, e :: Rational
                           s = fromTime $ start $ era d
                           e = fromTime $ end   $ era d
                       in  [s, s + 1^/rate .. e]
                      )
           )