{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}
-- UndecidableInstances needed for ghc < 707

-----------------------------------------------------------------------------
-- |
-- 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://ku-fpg.github.io/files/Matlage-10-BeginningMiddleEnd.pdf>), 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
-- (<https://diagrams.github.io>), 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, toTime, fromTime
       , Duration, toDuration, fromDuration

         -- ** Eras

       , Era, mkEra
       , start, end, duration

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

       , shiftDynamic

         -- * 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

         -- * Discretization

       , discrete
       , simulate

       ) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif

import           Control.Arrow       ((&&&))
import           Control.Lens        hiding (backwards, (<.>))

import           Data.Functor.Apply
import           Data.Maybe
import           Data.Monoid         (First (..))
import           Data.Semigroup      hiding (First (..))
import qualified Data.Vector         as V

import           Linear
import           Linear.Affine


------------------------------------------------------------
-- 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.
newtype Time n = Time { forall n. Time n -> n
unTime :: n }
  deriving (Time n -> Time n -> Bool
forall n. Eq n => Time n -> Time n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time n -> Time n -> Bool
$c/= :: forall n. Eq n => Time n -> Time n -> Bool
== :: Time n -> Time n -> Bool
$c== :: forall n. Eq n => Time n -> Time n -> Bool
Eq, Time n -> Time n -> Bool
Time n -> Time n -> Ordering
Time n -> Time n -> Time n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (Time n)
forall n. Ord n => Time n -> Time n -> Bool
forall n. Ord n => Time n -> Time n -> Ordering
forall n. Ord n => Time n -> Time n -> Time n
min :: Time n -> Time n -> Time n
$cmin :: forall n. Ord n => Time n -> Time n -> Time n
max :: Time n -> Time n -> Time n
$cmax :: forall n. Ord n => Time n -> Time n -> Time n
>= :: Time n -> Time n -> Bool
$c>= :: forall n. Ord n => Time n -> Time n -> Bool
> :: Time n -> Time n -> Bool
$c> :: forall n. Ord n => Time n -> Time n -> Bool
<= :: Time n -> Time n -> Bool
$c<= :: forall n. Ord n => Time n -> Time n -> Bool
< :: Time n -> Time n -> Bool
$c< :: forall n. Ord n => Time n -> Time n -> Bool
compare :: Time n -> Time n -> Ordering
$ccompare :: forall n. Ord n => Time n -> Time n -> Ordering
Ord, Int -> Time n -> ShowS
forall n. Show n => Int -> Time n -> ShowS
forall n. Show n => [Time n] -> ShowS
forall n. Show n => Time n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time n] -> ShowS
$cshowList :: forall n. Show n => [Time n] -> ShowS
show :: Time n -> String
$cshow :: forall n. Show n => Time n -> String
showsPrec :: Int -> Time n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Time n -> ShowS
Show, ReadPrec [Time n]
ReadPrec (Time n)
ReadS [Time n]
forall n. Read n => ReadPrec [Time n]
forall n. Read n => ReadPrec (Time n)
forall n. Read n => Int -> ReadS (Time n)
forall n. Read n => ReadS [Time n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Time n]
$creadListPrec :: forall n. Read n => ReadPrec [Time n]
readPrec :: ReadPrec (Time n)
$creadPrec :: forall n. Read n => ReadPrec (Time n)
readList :: ReadS [Time n]
$creadList :: forall n. Read n => ReadS [Time n]
readsPrec :: Int -> ReadS (Time n)
$creadsPrec :: forall n. Read n => Int -> ReadS (Time n)
Read, Int -> Time n
Time n -> Int
Time n -> [Time n]
Time n -> Time n
Time n -> Time n -> [Time n]
Time n -> Time n -> Time n -> [Time n]
forall n. Enum n => Int -> Time n
forall n. Enum n => Time n -> Int
forall n. Enum n => Time n -> [Time n]
forall n. Enum n => Time n -> Time n
forall n. Enum n => Time n -> Time n -> [Time n]
forall n. Enum n => Time n -> Time n -> Time n -> [Time n]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Time n -> Time n -> Time n -> [Time n]
$cenumFromThenTo :: forall n. Enum n => Time n -> Time n -> Time n -> [Time n]
enumFromTo :: Time n -> Time n -> [Time n]
$cenumFromTo :: forall n. Enum n => Time n -> Time n -> [Time n]
enumFromThen :: Time n -> Time n -> [Time n]
$cenumFromThen :: forall n. Enum n => Time n -> Time n -> [Time n]
enumFrom :: Time n -> [Time n]
$cenumFrom :: forall n. Enum n => Time n -> [Time n]
fromEnum :: Time n -> Int
$cfromEnum :: forall n. Enum n => Time n -> Int
toEnum :: Int -> Time n
$ctoEnum :: forall n. Enum n => Int -> Time n
pred :: Time n -> Time n
$cpred :: forall n. Enum n => Time n -> Time n
succ :: Time n -> Time n
$csucc :: forall n. Enum n => Time n -> Time n
Enum, Integer -> Time n
Time n -> Time n
Time n -> Time n -> Time n
forall n. Num n => Integer -> Time n
forall n. Num n => Time n -> Time n
forall n. Num n => Time n -> Time n -> Time n
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Time n
$cfromInteger :: forall n. Num n => Integer -> Time n
signum :: Time n -> Time n
$csignum :: forall n. Num n => Time n -> Time n
abs :: Time n -> Time n
$cabs :: forall n. Num n => Time n -> Time n
negate :: Time n -> Time n
$cnegate :: forall n. Num n => Time n -> Time n
* :: Time n -> Time n -> Time n
$c* :: forall n. Num n => Time n -> Time n -> Time n
- :: Time n -> Time n -> Time n
$c- :: forall n. Num n => Time n -> Time n -> Time n
+ :: Time n -> Time n -> Time n
$c+ :: forall n. Num n => Time n -> Time n -> Time n
Num, Rational -> Time n
Time n -> Time n
Time n -> Time n -> Time n
forall {n}. Fractional n => Num (Time n)
forall n. Fractional n => Rational -> Time n
forall n. Fractional n => Time n -> Time n
forall n. Fractional n => Time n -> Time n -> Time n
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Time n
$cfromRational :: forall n. Fractional n => Rational -> Time n
recip :: Time n -> Time n
$crecip :: forall n. Fractional n => Time n -> Time n
/ :: Time n -> Time n -> Time n
$c/ :: forall n. Fractional n => Time n -> Time n -> Time n
Fractional, Time n -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {n}. Real n => Num (Time n)
forall {n}. Real n => Ord (Time n)
forall n. Real n => Time n -> Rational
toRational :: Time n -> Rational
$ctoRational :: forall n. Real n => Time n -> Rational
Real, forall b. Integral b => Time n -> b
forall b. Integral b => Time n -> (b, Time n)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
forall {n}. RealFrac n => Fractional (Time n)
forall {n}. RealFrac n => Real (Time n)
forall n b. (RealFrac n, Integral b) => Time n -> b
forall n b. (RealFrac n, Integral b) => Time n -> (b, Time n)
floor :: forall b. Integral b => Time n -> b
$cfloor :: forall n b. (RealFrac n, Integral b) => Time n -> b
ceiling :: forall b. Integral b => Time n -> b
$cceiling :: forall n b. (RealFrac n, Integral b) => Time n -> b
round :: forall b. Integral b => Time n -> b
$cround :: forall n b. (RealFrac n, Integral b) => Time n -> b
truncate :: forall b. Integral b => Time n -> b
$ctruncate :: forall n b. (RealFrac n, Integral b) => Time n -> b
properFraction :: forall b. Integral b => Time n -> (b, Time n)
$cproperFraction :: forall n b. (RealFrac n, Integral b) => Time n -> (b, Time n)
RealFrac, forall a b. a -> Time b -> Time a
forall a b. (a -> b) -> Time a -> Time b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Time b -> Time a
$c<$ :: forall a b. a -> Time b -> Time a
fmap :: forall a b. (a -> b) -> Time a -> Time b
$cfmap :: forall a b. (a -> b) -> Time a -> Time b
Functor)

makeWrapped ''Time

-- | A convenient wrapper function to convert a numeric value into a time.
toTime :: n -> Time n
toTime :: forall n. n -> Time n
toTime = forall n. n -> Time n
Time

-- | A convenient unwrapper function to turn a time into a numeric value.
fromTime :: Time n -> n
fromTime :: forall n. Time n -> n
fromTime = forall n. Time n -> n
unTime

-- 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.
newtype Duration n = Duration n
  deriving (Duration n -> Duration n -> Bool
forall n. Eq n => Duration n -> Duration n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration n -> Duration n -> Bool
$c/= :: forall n. Eq n => Duration n -> Duration n -> Bool
== :: Duration n -> Duration n -> Bool
$c== :: forall n. Eq n => Duration n -> Duration n -> Bool
Eq, Duration n -> Duration n -> Bool
Duration n -> Duration n -> Ordering
Duration n -> Duration n -> Duration n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (Duration n)
forall n. Ord n => Duration n -> Duration n -> Bool
forall n. Ord n => Duration n -> Duration n -> Ordering
forall n. Ord n => Duration n -> Duration n -> Duration n
min :: Duration n -> Duration n -> Duration n
$cmin :: forall n. Ord n => Duration n -> Duration n -> Duration n
max :: Duration n -> Duration n -> Duration n
$cmax :: forall n. Ord n => Duration n -> Duration n -> Duration n
>= :: Duration n -> Duration n -> Bool
$c>= :: forall n. Ord n => Duration n -> Duration n -> Bool
> :: Duration n -> Duration n -> Bool
$c> :: forall n. Ord n => Duration n -> Duration n -> Bool
<= :: Duration n -> Duration n -> Bool
$c<= :: forall n. Ord n => Duration n -> Duration n -> Bool
< :: Duration n -> Duration n -> Bool
$c< :: forall n. Ord n => Duration n -> Duration n -> Bool
compare :: Duration n -> Duration n -> Ordering
$ccompare :: forall n. Ord n => Duration n -> Duration n -> Ordering
Ord, Int -> Duration n -> ShowS
forall n. Show n => Int -> Duration n -> ShowS
forall n. Show n => [Duration n] -> ShowS
forall n. Show n => Duration n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration n] -> ShowS
$cshowList :: forall n. Show n => [Duration n] -> ShowS
show :: Duration n -> String
$cshow :: forall n. Show n => Duration n -> String
showsPrec :: Int -> Duration n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Duration n -> ShowS
Show, ReadPrec [Duration n]
ReadPrec (Duration n)
ReadS [Duration n]
forall n. Read n => ReadPrec [Duration n]
forall n. Read n => ReadPrec (Duration n)
forall n. Read n => Int -> ReadS (Duration n)
forall n. Read n => ReadS [Duration n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Duration n]
$creadListPrec :: forall n. Read n => ReadPrec [Duration n]
readPrec :: ReadPrec (Duration n)
$creadPrec :: forall n. Read n => ReadPrec (Duration n)
readList :: ReadS [Duration n]
$creadList :: forall n. Read n => ReadS [Duration n]
readsPrec :: Int -> ReadS (Duration n)
$creadsPrec :: forall n. Read n => Int -> ReadS (Duration n)
Read, Int -> Duration n
Duration n -> Int
Duration n -> [Duration n]
Duration n -> Duration n
Duration n -> Duration n -> [Duration n]
Duration n -> Duration n -> Duration n -> [Duration n]
forall n. Enum n => Int -> Duration n
forall n. Enum n => Duration n -> Int
forall n. Enum n => Duration n -> [Duration n]
forall n. Enum n => Duration n -> Duration n
forall n. Enum n => Duration n -> Duration n -> [Duration n]
forall n.
Enum n =>
Duration n -> Duration n -> Duration n -> [Duration n]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Duration n -> Duration n -> Duration n -> [Duration n]
$cenumFromThenTo :: forall n.
Enum n =>
Duration n -> Duration n -> Duration n -> [Duration n]
enumFromTo :: Duration n -> Duration n -> [Duration n]
$cenumFromTo :: forall n. Enum n => Duration n -> Duration n -> [Duration n]
enumFromThen :: Duration n -> Duration n -> [Duration n]
$cenumFromThen :: forall n. Enum n => Duration n -> Duration n -> [Duration n]
enumFrom :: Duration n -> [Duration n]
$cenumFrom :: forall n. Enum n => Duration n -> [Duration n]
fromEnum :: Duration n -> Int
$cfromEnum :: forall n. Enum n => Duration n -> Int
toEnum :: Int -> Duration n
$ctoEnum :: forall n. Enum n => Int -> Duration n
pred :: Duration n -> Duration n
$cpred :: forall n. Enum n => Duration n -> Duration n
succ :: Duration n -> Duration n
$csucc :: forall n. Enum n => Duration n -> Duration n
Enum, Integer -> Duration n
Duration n -> Duration n
Duration n -> Duration n -> Duration n
forall n. Num n => Integer -> Duration n
forall n. Num n => Duration n -> Duration n
forall n. Num n => Duration n -> Duration n -> Duration n
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Duration n
$cfromInteger :: forall n. Num n => Integer -> Duration n
signum :: Duration n -> Duration n
$csignum :: forall n. Num n => Duration n -> Duration n
abs :: Duration n -> Duration n
$cabs :: forall n. Num n => Duration n -> Duration n
negate :: Duration n -> Duration n
$cnegate :: forall n. Num n => Duration n -> Duration n
* :: Duration n -> Duration n -> Duration n
$c* :: forall n. Num n => Duration n -> Duration n -> Duration n
- :: Duration n -> Duration n -> Duration n
$c- :: forall n. Num n => Duration n -> Duration n -> Duration n
+ :: Duration n -> Duration n -> Duration n
$c+ :: forall n. Num n => Duration n -> Duration n -> Duration n
Num, Rational -> Duration n
Duration n -> Duration n
Duration n -> Duration n -> Duration n
forall {n}. Fractional n => Num (Duration n)
forall n. Fractional n => Rational -> Duration n
forall n. Fractional n => Duration n -> Duration n
forall n. Fractional n => Duration n -> Duration n -> Duration n
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Duration n
$cfromRational :: forall n. Fractional n => Rational -> Duration n
recip :: Duration n -> Duration n
$crecip :: forall n. Fractional n => Duration n -> Duration n
/ :: Duration n -> Duration n -> Duration n
$c/ :: forall n. Fractional n => Duration n -> Duration n -> Duration n
Fractional, Duration n -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {n}. Real n => Num (Duration n)
forall {n}. Real n => Ord (Duration n)
forall n. Real n => Duration n -> Rational
toRational :: Duration n -> Rational
$ctoRational :: forall n. Real n => Duration n -> Rational
Real, forall b. Integral b => Duration n -> b
forall b. Integral b => Duration n -> (b, Duration n)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
forall {n}. RealFrac n => Fractional (Duration n)
forall {n}. RealFrac n => Real (Duration n)
forall n b. (RealFrac n, Integral b) => Duration n -> b
forall n b.
(RealFrac n, Integral b) =>
Duration n -> (b, Duration n)
floor :: forall b. Integral b => Duration n -> b
$cfloor :: forall n b. (RealFrac n, Integral b) => Duration n -> b
ceiling :: forall b. Integral b => Duration n -> b
$cceiling :: forall n b. (RealFrac n, Integral b) => Duration n -> b
round :: forall b. Integral b => Duration n -> b
$cround :: forall n b. (RealFrac n, Integral b) => Duration n -> b
truncate :: forall b. Integral b => Duration n -> b
$ctruncate :: forall n b. (RealFrac n, Integral b) => Duration n -> b
properFraction :: forall b. Integral b => Duration n -> (b, Duration n)
$cproperFraction :: forall n b.
(RealFrac n, Integral b) =>
Duration n -> (b, Duration n)
RealFrac, forall a b. a -> Duration b -> Duration a
forall a b. (a -> b) -> Duration a -> Duration b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Duration b -> Duration a
$c<$ :: forall a b. a -> Duration b -> Duration a
fmap :: forall a b. (a -> b) -> Duration a -> Duration b
$cfmap :: forall a b. (a -> b) -> Duration a -> Duration b
Functor)

-- | A convenient wrapper function to convert a numeric value into a duration.
toDuration :: n -> Duration n
toDuration :: forall n. n -> Duration n
toDuration = forall n. n -> Duration n
Duration

-- | A convenient unwrapper function to turn a duration into a numeric value.
fromDuration :: Duration n -> n
fromDuration :: forall n. Duration n -> n
fromDuration (Duration n
n) = n
n

instance Applicative Duration where
  pure :: forall n. n -> Duration n
pure = forall n. n -> Duration n
Duration
  Duration a -> b
f <*> :: forall a b. Duration (a -> b) -> Duration a -> Duration b
<*> Duration a
x = forall n. n -> Duration n
Duration (a -> b
f a
x)

instance Additive Duration where
  zero :: forall a. Num a => Duration a
zero = Duration a
0

instance Num n => Semigroup (Duration n) where
  <> :: Duration n -> Duration n -> Duration n
(<>) = forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^)

instance Num n => Monoid (Duration n) where
  mappend :: Duration n -> Duration n -> Duration n
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Duration n
mempty  = Duration n
0

instance Affine Time where
  -- It is important that this deffinition comes *after*
  -- the 'Additive' instance of 'Duration' to build with GHC-9.0
  type Diff Time = Duration
  (Time a
t1) .-. :: forall a. Num a => Time a -> Time a -> Diff Time a
.-. (Time a
t2) = forall n. n -> Duration n
Duration (a
t1 forall a. Num a => a -> a -> a
- a
t2)
  (Time a
t) .+^ :: forall a. Num a => Time a -> Diff Time a -> Time a
.+^ (Duration a
d) = forall n. n -> Time n
Time (a
t forall a. Num a => a -> a -> a
+ a
d)

makeWrapped ''Duration

-- | 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 n = Era (Min (Time n), Max (Time n))
  deriving (Int -> Era n -> ShowS
forall n. Show n => Int -> Era n -> ShowS
forall n. Show n => [Era n] -> ShowS
forall n. Show n => Era n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Era n] -> ShowS
$cshowList :: forall n. Show n => [Era n] -> ShowS
show :: Era n -> String
$cshow :: forall n. Show n => Era n -> String
showsPrec :: Int -> Era n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Era n -> ShowS
Show, NonEmpty (Era n) -> Era n
Era n -> Era n -> Era n
forall b. Integral b => b -> Era n -> Era n
forall n. Ord n => NonEmpty (Era n) -> Era n
forall n. Ord n => Era n -> Era n -> Era n
forall n b. (Ord n, Integral b) => b -> Era n -> Era n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Era n -> Era n
$cstimes :: forall n b. (Ord n, Integral b) => b -> Era n -> Era n
sconcat :: NonEmpty (Era n) -> Era n
$csconcat :: forall n. Ord n => NonEmpty (Era n) -> Era n
<> :: Era n -> Era n -> Era n
$c<> :: forall n. Ord n => Era n -> Era n -> Era n
Semigroup)


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

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

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

-- | Compute the 'Duration' of an 'Era'.
duration :: Num n => Era n -> Duration n
duration :: forall n. Num n => Era n -> Duration n
duration = forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
(.-.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Era n -> Time n
end forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall n. Era n -> Time n
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 a = Dynamic { forall a. Dynamic a -> Era Rational
era        :: Era Rational
                         , forall a. Dynamic a -> Time Rational -> a
runDynamic :: Time Rational -> a
                         }
  deriving forall a b. a -> Dynamic b -> Dynamic a
forall a b. (a -> b) -> Dynamic a -> Dynamic b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Dynamic b -> Dynamic a
$c<$ :: forall a b. a -> Dynamic b -> Dynamic a
fmap :: forall a b. (a -> b) -> Dynamic a -> Dynamic b
$cfmap :: forall a b. (a -> b) -> Dynamic a -> Dynamic b
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 Apply Dynamic where
  (Dynamic Era Rational
d1 Time Rational -> a -> b
f1) <.> :: forall a b. Dynamic (a -> b) -> Dynamic a -> Dynamic b
<.> (Dynamic Era Rational
d2 Time Rational -> a
f2) = forall a. Era Rational -> (Time Rational -> a) -> Dynamic a
Dynamic (Era Rational
d1 forall a. Semigroup a => a -> a -> a
<> Era Rational
d2) (Time Rational -> a -> b
f1 forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> Time Rational -> a
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 Semigroup a => Semigroup (Dynamic a) where
  Dynamic Era Rational
d1 Time Rational -> a
f1 <> :: Dynamic a -> Dynamic a -> Dynamic a
<> Dynamic Era Rational
d2 Time Rational -> a
f2 = forall a. Era Rational -> (Time Rational -> a) -> Dynamic a
Dynamic (Era Rational
d1 forall a. Semigroup a => a -> a -> a
<> Era Rational
d2) (Time Rational -> a
f1 forall a. Semigroup a => a -> a -> a
<> Time Rational -> a
f2)

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

-- | Fold for 'Dynamic'.
onDynamic :: (Time Rational -> Time Rational -> (Time Rational -> a) -> b) -> Dynamic a -> b
onDynamic :: forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic Time Rational -> Time Rational -> (Time Rational -> a) -> b
f (Dynamic Era Rational
e Time Rational -> a
d) = Time Rational -> Time Rational -> (Time Rational -> a) -> b
f (forall n. Era n -> Time n
start Era Rational
e) (forall n. Era n -> Time n
end Era Rational
e) Time Rational -> a
d

-- | Shift a 'Dynamic' value by a certain duration.
shiftDynamic :: Duration Rational -> Dynamic a -> Dynamic a
shiftDynamic :: forall a. Duration Rational -> Dynamic a -> Dynamic a
shiftDynamic Duration Rational
sh =
  forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic
      (Time Rational
s forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Duration Rational
sh)
      (Time Rational
e forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Duration Rational
sh)
      (\Time Rational
t -> Time Rational -> a
d (Time Rational
t forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.-^ Duration Rational
sh))

------------------------------------------------------------
--  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 a = Active (MaybeApply Dynamic a)
  deriving (forall a b. a -> Active b -> Active a
forall a b. (a -> b) -> Active a -> Active b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Active b -> Active a
$c<$ :: forall a b. a -> Active b -> Active a
fmap :: forall a b. (a -> b) -> Active a -> Active b
$cfmap :: forall a b. (a -> b) -> Active a -> Active b
Functor, Functor Active
forall a b. Active a -> Active b -> Active a
forall a b. Active a -> Active b -> Active b
forall a b. Active (a -> b) -> Active a -> Active b
forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
forall (f :: * -> *).
Functor f
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Apply f
liftF2 :: forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
$cliftF2 :: forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
<. :: forall a b. Active a -> Active b -> Active a
$c<. :: forall a b. Active a -> Active b -> Active a
.> :: forall a b. Active a -> Active b -> Active b
$c.> :: forall a b. Active a -> Active b -> Active b
<.> :: forall a b. Active (a -> b) -> Active a -> Active b
$c<.> :: forall a b. Active (a -> b) -> Active a -> Active b
Apply, Functor Active
forall a. a -> Active a
forall a b. Active a -> Active b -> Active a
forall a b. Active a -> Active b -> Active b
forall a b. Active (a -> b) -> Active a -> Active b
forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Active a -> Active b -> Active a
$c<* :: forall a b. Active a -> Active b -> Active a
*> :: forall a b. Active a -> Active b -> Active b
$c*> :: forall a b. Active a -> Active b -> Active b
liftA2 :: forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
$cliftA2 :: forall a b c. (a -> b -> c) -> Active a -> Active b -> Active c
<*> :: forall a b. Active (a -> b) -> Active a -> Active b
$c<*> :: forall a b. Active (a -> b) -> Active a -> Active b
pure :: forall a. a -> Active a
$cpure :: forall a. a -> Active a
Applicative)

makeWrapped ''Active

active :: Iso' (Active a) (Either (Dynamic a) a)
active :: forall a. Iso' (Active a) (Either (Dynamic a) a)
active = forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply

-- | 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 Semigroup a => Semigroup (Active a) where
  (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Iso' (Active a) (Either (Dynamic a) a)
active -> Either (Dynamic a) a
a) <> :: Active a -> Active a -> Active a
<> (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Iso' (Active a) (Either (Dynamic a) a)
active -> Either (Dynamic a) a
b) = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall a. Iso' (Active a) (Either (Dynamic a) a)
active forall a b. (a -> b) -> a -> b
$ forall {a}.
Semigroup a =>
Either (Dynamic a) a
-> Either (Dynamic a) a -> Either (Dynamic a) a
combine Either (Dynamic a) a
a Either (Dynamic a) a
b
   where
     combine :: Either (Dynamic a) a
-> Either (Dynamic a) a -> Either (Dynamic a) a
combine (Right a
m1) (Right a
m2)
       = forall a b. b -> Either a b
Right (a
m1 forall a. Semigroup a => a -> a -> a
<> a
m2)

     combine (Left (Dynamic Era Rational
dur Time Rational -> a
f)) (Right a
m)
       = forall a b. a -> Either a b
Left (forall a. Era Rational -> (Time Rational -> a) -> Dynamic a
Dynamic Era Rational
dur (Time Rational -> a
f forall a. Semigroup a => a -> a -> a
<> forall a b. a -> b -> a
const a
m))

     combine (Right a
m) (Left (Dynamic Era Rational
dur Time Rational -> a
f))
       = forall a b. a -> Either a b
Left (forall a. Era Rational -> (Time Rational -> a) -> Dynamic a
Dynamic Era Rational
dur (forall a b. a -> b -> a
const a
m forall a. Semigroup a => a -> a -> a
<> Time Rational -> a
f))

     combine (Left Dynamic a
d1) (Left Dynamic a
d2)
       = forall a b. a -> Either a b
Left (Dynamic a
d1 forall a. Semigroup a => a -> a -> a
<> Dynamic a
d2)

instance (Monoid a, Semigroup a) => Monoid (Active a) where
  mempty :: Active a
mempty  = forall a. MaybeApply Dynamic a -> Active a
Active (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty))
  mappend :: Active a -> Active a -> Active a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Create an 'Active' value from a 'Dynamic'.
fromDynamic :: Dynamic a -> Active a
fromDynamic :: forall a. Dynamic a -> Active a
fromDynamic = forall a. MaybeApply Dynamic a -> Active a
Active forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

-- | Create a dynamic 'Active' from a start time, an end time, and a
--   time-varying value.
mkActive :: Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive :: forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive Time Rational
s Time Rational
e Time Rational -> a
f = forall a. Dynamic a -> Active a
fromDynamic (forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e Time Rational -> a
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 a -> b) -> Active a -> b
onActive :: forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive a -> b
f Dynamic a -> b
_ (Active (MaybeApply (Right a
a))) = a -> b
f a
a
onActive a -> b
_ Dynamic a -> b
f (Active (MaybeApply (Left Dynamic a
d)))  = Dynamic a -> b
f Dynamic a
d

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

-- | Interpret an 'Active' value as a function from time.
runActive :: Active a -> Time Rational -> a
runActive :: forall a. Active a -> Time Rational -> a
runActive = forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive forall a b. a -> b -> a
const forall a. Dynamic a -> Time Rational -> a
runDynamic

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

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

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

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

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

------------------------------------------------------------
--  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:
--
--   <<diagrams/src_Data_Active_uiDia.svg#diagram=uiDia&width=200>>
--
--   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'.
ui :: Fractional a => Active a
ui :: forall a. Fractional a => Active a
ui = forall a.
Fractional a =>
Time Rational -> Time Rational -> Active a
interval Time Rational
0 Time Rational
1

-- | @interval a b@ is an active value starting at time @a@, ending at
--   time @b@, and taking the value @t@ at time @t@.
interval :: Fractional a => Time Rational -> Time Rational -> Active a
interval :: forall a.
Fractional a =>
Time Rational -> Time Rational -> Active a
interval Time Rational
a Time Rational
b = forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive Time Rational
a Time Rational
b (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Time n -> n
unTime)

-- | @stretch s act@ \"stretches\" the active @act@ so that it takes
--   @s@ times as long (retaining the same start time).
stretch :: Rational -> Active a -> Active a
stretch :: forall a. Rational -> Active a -> Active a
stretch Rational
str =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s (Time Rational
s forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Rational
str forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Time Rational
e forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Time Rational
s)))
      (\Time Rational
t -> Time Rational -> a
d (Time Rational
s forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ ((Time Rational
t forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Time Rational
s) forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ Rational
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 :: Duration Rational -> Active a -> Active a
stretchTo :: forall a. Duration Rational -> Active a -> Active a
stretchTo Duration Rational
d Active a
a
  | Duration Rational
d forall a. Ord a => a -> a -> Bool
<= Duration Rational
0                               = Active a
a
  | (forall n. Num n => Era n -> Duration n
duration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Active a -> Maybe (Era Rational)
activeEra Active a
a) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Duration Rational
0 = Active a
a
  | Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Active a
a (forall a. Rational -> Active a -> Active a
`stretch` Active a
a) ((forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Duration Rational
d forall a. Fractional a => a -> a -> a
/) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => Era n -> Duration n
duration) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Active a -> Maybe (Era Rational)
activeEra Active a
a)

-- | @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 :: Active a -> Active a -> Active a
during :: forall a. Active a -> Active a -> Active a
during Active a
a1 Active a
a2 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Active a
a1 (\(Duration Rational
d,Time Rational
s) -> forall a. Duration Rational -> Active a -> Active a
stretchTo Duration Rational
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Time Rational -> Active a -> Active a
atTime Time Rational
s forall a b. (a -> b) -> a -> b
$ Active a
a1)
                 ((forall n. Num n => Era n -> Duration n
duration forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall n. Era n -> Time n
start) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Active a -> Maybe (Era Rational)
activeEra Active a
a2)

-- | @shift d act@ shifts the start time of @act@ by duration @d@.
--   Has no effect on constant values.
shift :: Duration Rational -> Active a -> Active a
shift :: forall a. Duration Rational -> Active a -> Active a
shift Duration Rational
sh = forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id (forall a. Duration Rational -> Dynamic a -> Dynamic a
shiftDynamic Duration Rational
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
--
--   <<diagrams/src_Data_Active_backwardsDia.svg#diagram=backwardsDia&width=200>>
backwards :: Active a -> Active a
backwards :: forall a. Active a -> Active a
backwards =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e
      (\Time Rational
t -> Time Rational -> a
d (Time Rational
s forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Time Rational
e forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Time Rational
t)))


-- | Take a \"snapshot\" of an active value at a particular time,
--   resulting in a constant value.
snapshot :: Time Rational -> Active a -> Active a
snapshot :: forall a. Time Rational -> Active a -> Active a
snapshot Time Rational
t Active a
a = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Active a -> Time Rational -> a
runActive Active a
a Time Rational
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
--
--   <<diagrams/src_Data_Active_clampDia.svg#diagram=clampDia&width=200>>
--
--   See also 'clampBefore' and 'clampAfter', which clamp only before
--   or after the era, respectively.

clamp :: Active a -> Active a
clamp :: forall a. Active a -> Active a
clamp =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e
      (\Time Rational
t -> case () of ()
_ | Time Rational
t forall a. Ord a => a -> a -> Bool
< Time Rational
s     -> Time Rational -> a
d Time Rational
s
                          | Time Rational
t forall a. Ord a => a -> a -> Bool
> Time Rational
e     -> Time Rational -> a
d Time Rational
e
                          | Bool
otherwise -> Time Rational -> a
d Time Rational
t
      )

-- | \"Clamp\" an active value so that it is constant before the start
--   of its era. For example, @clampBefore 'ui'@ can be visualized as
--
--   <<diagrams/src_Data_Active_clampBeforeDia.svg#diagram=clampBeforeDia&width=200>>
--
--   See the documentation of 'clamp' for more information.
clampBefore :: Active a -> Active a
clampBefore :: forall a. Active a -> Active a
clampBefore = forall a. HasCallStack => a
undefined

--- XXX These are undefined!

-- | \"Clamp\" an active value so that it is constant after the end
--   of its era.  For example, @clampBefore 'ui'@ can be visualized as
--
--   <<diagrams/src_Data_Active_clampAfterDia.svg#diagram=clampAfterDia&width=200>>
--
--   See the documentation of 'clamp' for more information.
clampAfter :: Active a -> Active a
clampAfter :: forall a. Active a -> Active a
clampAfter = forall a. HasCallStack => a
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
--
--   <<diagrams/src_Data_Active_trimDia.svg#diagram=trimDia&width=200>>
--
--   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 :: Monoid a => Active a -> Active a
trim :: forall a. Monoid a => Active a -> Active a
trim =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e
      (\Time Rational
t -> case () of ()
_ | Time Rational
t forall a. Ord a => a -> a -> Bool
< Time Rational
s     -> forall a. Monoid a => a
mempty
                          | Time Rational
t forall a. Ord a => a -> a -> Bool
> Time Rational
e     -> forall a. Monoid a => a
mempty
                          | Bool
otherwise -> Time Rational -> a
d Time Rational
t
      )


-- | \"Trim\" an active value so that it is empty /before/ the start
--   of its era. For example, @trimBefore 'ui'@ can be visualized as
--
--   <<diagrams/src_Data_Active_trimBeforeDia.svg#diagram=trimBeforeDia&width=200>>
--
--   See the documentation of 'trim' for more details.
trimBefore :: Monoid a => Active a -> Active a
trimBefore :: forall a. Monoid a => Active a -> Active a
trimBefore =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e
      (\Time Rational
t -> case () of ()
_ | Time Rational
t forall a. Ord a => a -> a -> Bool
< Time Rational
s     -> forall a. Monoid a => a
mempty
                          | Bool
otherwise -> Time Rational -> a
d Time Rational
t
      )

-- | \"Trim\" an active value so that it is empty /after/ the end
--   of its era.  For example, @trimAfter 'ui'@ can be visualized as
--
--   <<diagrams/src_Data_Active_trimAfterDia.svg#diagram=trimAfterDia&width=200>>
--
--   See the documentation of 'trim' for more details.
trimAfter :: Monoid a => Active a -> Active a
trimAfter :: forall a. Monoid a => Active a -> Active a
trimAfter =
  forall a b.
(a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active b
modActive forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic forall a b. (a -> b) -> a -> b
$ \Time Rational
s Time Rational
e Time Rational -> a
d ->
    forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic Time Rational
s Time Rational
e
      (\Time Rational
t -> case () of ()
_ | Time Rational
t forall a. Ord a => a -> a -> Bool
> Time Rational
e     -> forall a. Monoid a => a
mempty
                          | Bool
otherwise -> Time Rational -> a
d Time Rational
t
      )

-- | 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 Rational -> Active a -> Active a
setEra :: forall a. Era Rational -> Active a -> Active a
setEra Era Rational
er =
  forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive
    (forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive (forall n. Era n -> Time n
start Era Rational
er) (forall n. Era n -> Time n
end Era Rational
er) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const)
    (forall a. Dynamic a -> Active a
fromDynamic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic (\Time Rational
_ Time Rational
_ -> forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a
mkDynamic (forall n. Era n -> Time n
start Era Rational
er) (forall n. Era n -> Time n
end Era Rational
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 :: Time Rational -> Active a -> Active a
atTime :: forall a. Time Rational -> Active a -> Active a
atTime Time Rational
t Active a
a = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Active a
a (\Era Rational
e -> forall a. Duration Rational -> Active a -> Active a
shift (Time Rational
t forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. forall n. Era n -> Time n
start Era Rational
e) Active a
a) (forall a. Active a -> Maybe (Era Rational)
activeEra Active a
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 :: Active a -> Active a -> Active a
after :: forall a. Active a -> Active a -> Active a
after Active a
a1 Active a
a2 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Active a
a1 ((forall a. Time Rational -> Active a -> Active a
`atTime` Active a
a1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Era n -> Time n
end) (forall a. Active a -> Maybe (Era Rational)
activeEra Active a
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 '<>').
(->>) :: Semigroup a => Active a -> Active a -> Active a
Active a
a1 ->> :: forall a. Semigroup a => Active a -> Active a -> Active a
->> Active a
a2 = Active a
a1 forall a. Semigroup a => a -> a -> a
<> (Active a
a2 forall a. Active a -> Active a -> Active a
`after` Active a
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.
(|>>) :: Active a -> Active a -> Active a
Active a
a1 |>> :: forall a. Active a -> Active a -> Active a
|>> Active a
a2 = (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. First a -> Maybe a
getFirst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (forall a. Monoid a => Active a -> Active a
trimAfter (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Active a
a1) forall a. Semigroup a => Active a -> Active a -> Active a
->> forall a. Monoid a => Active a -> Active a
trimBefore (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Active a
a2))

-- XXX implement 'movie' with a balanced fold

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

------------------------------------------------------------
--  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 :: [a] -> Active a
discrete :: forall a. [a] -> Active a
discrete [] = forall a. HasCallStack => String -> a
error String
"Data.Active.discrete must be called with a non-empty list."
discrete [a]
xs = Rational -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fractional a => Active a
ui
  where f :: Rational -> a
f (Rational
t :: Rational)
            | Rational
t forall a. Ord a => a -> a -> Bool
<= Rational
0    = forall a. Vector a -> a
V.unsafeHead Vector a
v
            | Rational
t forall a. Ord a => a -> a -> Bool
>= Rational
1    = forall a. Vector a -> a
V.unsafeLast Vector a
v
            | Bool
otherwise = forall a. Vector a -> Int -> a
V.unsafeIndex Vector a
v forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
t forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
V.length Vector a
v))
        v :: Vector a
v = forall a. [a] -> Vector a
V.fromList [a]
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 :: Rational -> Active a -> [a]
simulate :: forall a. Rational -> Active a -> [a]
simulate Rational
0    = forall a b. a -> b -> a
const []
simulate Rational
rate =
  forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive (forall a. a -> [a] -> [a]
:[])
           (\Dynamic a
d -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Dynamic a -> Time Rational -> a
runDynamic Dynamic a
d)
                      (let s :: Time Rational
s = forall n. Era n -> Time n
start (forall a. Dynamic a -> Era Rational
era Dynamic a
d)
                           e :: Time Rational
e = forall n. Era n -> Time n
end   (forall a. Dynamic a -> Era Rational
era Dynamic a
d)
                       in  [Time Rational
s, Time Rational
s forall a. Num a => a -> a -> a
+ Time Rational
1forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/Rational
rate .. Time Rational
e]
                      )
           )

------------------------------------------------------------
-- Illustrations produced with diagrams-haddock
--
-- > d :: Diagram B -> Diagram B
-- > d fun = (square 4 <> ends <> fun # lc red)
-- >       # lineCap LineCapRound # lineJoin LineJoinRound
-- >       # frame 1
-- >   where ends = vert <> vert # translateX 1
-- >                <> rect 1 4 # translateX (0.5) # opacity 0.2 # fc grey
-- >         vert = vrule 4 # dashingG [0.1,0.1] 0 # lc grey
-- >
-- > uiDia = d $
-- >   ((-2) ^& (-2)) ~~ (2 ^& 2)
-- >
-- > backwardsDia = d $
-- >   (2 ^& (-1)) ~~ ((-1) ^& 2)
-- >
-- > clampDia = d $
-- >   [(2,0), (1,1), (1,0)]
-- >   # map r2 # fromOffsets # centerX
-- >
-- > clampBeforeDia = d $
-- >   [(2,0), (2,2)]
-- >   # map r2 # fromOffsets # centerX
-- >
-- > clampAfterDia = d $
-- >   [(3,3), (1,0)]
-- >   # map r2 # fromOffsets # centerX # translateY (-2)
-- >
-- > trimDia = d $ origin ~~ (1 ^& 1)
-- >
-- > trimBeforeDia = d $ origin ~~ (2 ^& 2)
-- >
-- > trimAfterDia = d $ ((-2) ^& (-2)) ~~ (1 ^& 1)