{-# LANGUAGE DeriveFunctor
, GeneralizedNewtypeDeriving
, TypeSynonymInstances
, MultiParamTypeClasses
, TypeFamilies
, FlexibleInstances
#-}{-# 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.-------------------------------------------------------------------------------moduleData.Active(-- * Representing time-- ** Time and durationTime,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)whereimportControl.ApplicativeimportControl.Arrow((&&&))importControl.NewtypeimportData.ArrayimportData.MaybeimportData.Functor.ApplyimportData.Semigrouphiding(First(..))importData.Monoid(First(..))importData.VectorSpacehiding((<.>))importData.AffineSpace-------------------------------------------------------------- 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.newtypeTime=Time{unTime::Rational}deriving(Eq,Ord,Show,Read,Enum,Num,Fractional,Real,RealFrac,AdditiveGroup,InnerSpace)instanceNewtypeTimeRationalwherepack=Timeunpack=unTimeinstanceVectorSpaceTimewheretypeScalarTime=Rationals*^(Timet)=Time(s*t)-- | Convert any value of a 'Real' type (including @Int@, @Integer@,-- @Rational@, @Float@, and @Double@) to a 'Time'.toTime::Reala=>a->TimetoTime=fromRational.toRational-- | Convert a 'Time' to a value of any 'Fractional' type (such as-- @Rational@, @Float@, or @Double@).fromTime::Fractionala=>Time->afromTime=fromRational.unTime-- | 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.newtypeDuration=Duration{unDuration::Rational}deriving(Eq,Ord,Show,Read,Enum,Num,Fractional,Real,RealFrac,AdditiveGroup)instanceNewtypeDurationRationalwherepack=Durationunpack=unDurationinstanceVectorSpaceDurationwheretypeScalarDuration=Rationals*^(Durationd)=Duration(s*d)instanceAffineSpaceTimewheretypeDiffTime=Duration(Timet1).-.(Timet2)=Duration(t1-t2)(Timet).+^(Durationd)=Time(t+d)-- | Convert any value of a 'Real' type (including @Int@, @Integer@,-- @Rational@, @Float@, and @Double@) to a 'Duration'.toDuration::Reala=>a->DurationtoDuration=fromRational.toRational-- | Convert a 'Duration' to any other 'Fractional' type (such as-- @Rational@, @Float@, or @Double@).fromDuration::Fractionala=>Duration->afromDuration=fromRational.unDuration-- | 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'.newtypeEra=Era(MinTime,MaxTime)deriving(Semigroup,Show)-- | Create an 'Era' by specifying start and end 'Time's.mkEra::Time->Time->EramkErase=Era(Mins,Maxe)-- | Get the start 'Time' of an 'Era'.start::Era->Timestart(Era(Mint,_))=t-- | Get the end 'Time' of an 'Era'.end::Era->Timeend(Era(_,Maxt))=t-- | Compute the 'Duration' of an 'Era'.duration::Era->Durationduration=(.-.)<$>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.dataDynamica=Dynamic{era::Era,runDynamic::Time->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').instanceApplyDynamicwhere(Dynamicd1f1)<.>(Dynamicd2f2)=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.instanceSemigroupa=>Semigroup(Dynamica)whereDynamicd1f1<>Dynamicd2f2=Dynamic(d1<>d2)(f1<>f2)-- | Create a 'Dynamic' from a start time, an end time, and a-- time-varying value.mkDynamic::Time->Time->(Time->a)->DynamicamkDynamicse=Dynamic(mkErase)-- | Fold for 'Dynamic'.onDynamic::(Time->Time->(Time->a)->b)->Dynamica->bonDynamicf(Dynamiced)=f(starte)(ende)d-- | Shift a 'Dynamic' value by a certain duration.shiftDynamic::Duration->Dynamica->DynamicashiftDynamicsh=onDynamic$\sed->mkDynamic(s.+^sh)(e.+^sh)(\t->d(t.-^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'.newtypeActivea=Active(MaybeApplyDynamica)deriving(Functor,Apply,Applicative)instanceNewtype(Activea)(MaybeApplyDynamica)wherepack=Activeunpack(Activem)=minstanceNewtype(MaybeApplyfa)(Either(fa)a)wherepack=MaybeApplyunpack=runMaybeApply-- | Ideally this would be defined in the @newtype@ package. If it is-- ever added we can remove it from here.over2::(Newtypeno,Newtypen'o',Newtypen''o'')=>(o->n)->(o->o'->o'')->(n->n'->n'')over2_fn1n2=pack(f(unpackn1)(unpackn2))-- | 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.instanceSemigroupa=>Semigroup(Activea)where(<>)=(over2Active.over2MaybeApply)combinewherecombine(Rightm1)(Rightm2)=Right(m1<>m2)combine(Left(Dynamicdurf))(Rightm)=Left(Dynamicdur(f<>constm))combine(Rightm)(Left(Dynamicdurf))=Left(Dynamicdur(constm<>f))combine(Leftd1)(Leftd2)=Left(d1<>d2)instance(Monoida,Semigroupa)=>Monoid(Activea)wheremempty=Active(MaybeApply(Rightmempty))mappend=(<>)-- | Create an 'Active' value from a 'Dynamic'.fromDynamic::Dynamica->ActiveafromDynamic=Active.MaybeApply.Left-- | Create a dynamic 'Active' from a start time, an end time, and a-- time-varying value.mkActive::Time->Time->(Time->a)->ActiveamkActivesef=fromDynamic(mkDynamicsef)-- | 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)->(Dynamica->b)->Activea->bonActivef_(Active(MaybeApply(Righta)))=faonActive_f(Active(MaybeApply(Leftd)))=fd-- | Modify an 'Active' value using a case analysis to see whether it-- is constant or dynamic.modActive::(a->b)->(Dynamica->Dynamicb)->Activea->ActivebmodActivefg=onActive(pure.f)(fromDynamic.g)-- | Interpret an 'Active' value as a function from time.runActive::Activea->(Time->a)runActive=onActiveconstrunDynamic-- | Get the value of an @Active a@ at the beginning of its era.activeStart::Activea->aactiveStart=onActiveid(onDynamic$\s_d->ds)-- | Get the value of an @Active a@ at the end of its era.activeEnd::Activea->aactiveEnd=onActiveid(onDynamic$\_ed->de)-- | Get the 'Era' of an 'Active' value (or 'Nothing' if it is-- a constant/pure value).activeEra::Activea->MaybeEraactiveEra=onActive(constNothing)(Just.era)-- | Test whether an 'Active' value is constant.isConstant::Activea->BoolisConstant=onActive(constTrue)(constFalse)-- | Test whether an 'Active' value is 'Dynamic'.isDynamic::Activea->BoolisDynamic=onActive(constFalse)(constTrue)-------------------------------------------------------------- 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'.ui::Fractionala=>Activeaui=interval01-- | @interval a b@ is an active value starting at time @a@, ending at-- time @b@, and taking the value @t@ at time @t@.interval::Fractionala=>Time->Time->Activeaintervalab=mkActiveab(fromRational.unTime)-- | @stretch s act@ \"stretches\" the active @act@ so that it takes-- @s@ times as long (retaining the same start time).stretch::Rational->Activea->Activeastretchstr=modActiveid.onDynamic$\sed->mkDynamics(s.+^(str*^(e.-.s)))(\t->d(s.+^((t.-.s)^/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.stretchTo::Duration->Activea->ActiveastretchToda|d<=0=a|(duration<$>activeEraa)==Just0=a|otherwise=maybea(`stretch`a)((toRational.(d/).duration)<$>activeEraa)-- | @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::Activea->Activea->Activeaduringa1a2=maybea1(\(d,s)->stretchTod.atTimes$a1)((duration&&&start)<$>activeEraa2)-- | @shift d act@ shifts the start time of @act@ by duration @d@.-- Has no effect on constant values.shift::Duration->Activea->Activeashiftsh=modActiveid(shiftDynamicsh)-- | 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::Activea->Activeabackwards=modActiveid.onDynamic$\sed->mkDynamicse(\t->d(e-t+s))-- | Take a \"snapshot\" of an active value at a particular time,-- resulting in a constant value.snapshot::Time->Activea->Activeasnapshotta=pure(runActiveat)-- | \"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::Activea->Activeaclamp=modActiveid.onDynamic$\sed->mkDynamicse(\t->case()of_|t<s->ds|t>e->de|otherwise->dt)-- | \"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::Activea->ActiveaclampBefore=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::Activea->ActiveaclampAfter=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::Monoida=>Activea->Activeatrim=modActiveid.onDynamic$\sed->mkDynamicse(\t->case()of_|t<s->mempty|t>e->mempty|otherwise->dt)-- | \"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::Monoida=>Activea->ActiveatrimBefore=modActiveid.onDynamic$\sed->mkDynamicse(\t->case()of_|t<s->mempty|otherwise->dt)-- | \"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::Monoida=>Activea->ActiveatrimAfter=modActiveid.onDynamic$\sed->mkDynamicse(\t->case()of_|t>e->mempty|otherwise->dt)-- | 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->Activea->ActiveasetEraer=onActive(mkActive(starter)(ender).const)(fromDynamic.onDynamic(\__->mkDynamic(starter)(ender)))-- | @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->Activea->ActiveaatTimeta=maybea(\e->shift(t.-.starte)a)(activeEraa)-- | @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::Activea->Activea->Activeaaftera1a2=maybea1((`atTime`a1).end)(activeEraa2)infixr5->>-- XXX illustrate-- | Sequence/overlay two 'Active' values: shift the second to start-- immediately after the first (using 'after'), then compose them-- (using '<>').(->>)::Semigroupa=>Activea->Activea->Activeaa1->>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.(|>>)::Activea->Activea->Activeaa1|>>a2=(fromJust.getFirst)<$>(trimAfter(First.Just<$>a1)->>trimBefore(First.Just<$>a2))-- XXX implement 'movie' with a balanced fold-- | Splice together a list of active values using '|>>'. The list-- must be nonempty.movie::[Activea]->Activeamovie=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::[a]->Activeadiscrete[]=error"Data.Active.discrete must be called with a non-empty list."discretexs=f<$>(ui::ActiveRational)whereft|t<=0=arr!0|t>=1=arr!(n-1)|otherwise=arr!floor(t*fromIntegraln)n=lengthxsarr=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::Rational->Activea->[a]simulaterate=onActive(:[])(\d->map(runDynamicd)(lets=start(erad)e=end(erad)in[s,s+1^/rate..e]))