active 0.1.0.15 → 0.1.0.16

raw patch · 4 files changed

+175/−227 lines, 4 filesdep ~semigroupoidsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: semigroupoids

API changes (from Hackage documentation)

Files

• CHANGES +12/−1
• active.cabal +4/−4
• src/Data/Active.hs +131/−193
• test/active-tests.hs +28/−29

@@ -1,6 +1,17 @@-0.1.0.15 (28 May 2014)+0.1.0.16 (2 June 2014)+---------------------- +  * correct version constraint problems with previous release++0.1.0.15 (28 May 2014) (BROKEN)+-------------------------------+   * allow semigroups-0.15++0.1.0.14 (15 May 2014)+------------------------++  * allow semigroups-0.14  0.1.0.13 (20 April 2014) ------------------------

@@ -1,5 +1,5 @@ name:                active-version:             0.1.0.15+version:             0.1.0.16 synopsis:            Abstractions for animation description:         "Active" abstraction for animated things with finite start and end times. license:             BSD3@@ -11,7 +11,7 @@ build-type:          Simple cabal-version:       >=1.10 extra-source-files:  CHANGES-tested-with:         GHC == 7.6.1+tested-with:         GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.1, GHC == 7.6.1 bug-reports:         https://github.com/diagrams/active/issues source-repository head   type:     git@@ -22,7 +22,7 @@   build-depends:       base >= 4.0 && < 4.8,                        array >= 0.3 && < 0.6,                        semigroups >= 0.1 && < 0.16,-                       semigroupoids >= 1.2 && < 3.2,+                       semigroupoids >= 1.2 && < 4.1,                        vector-space >= 0.8 && < 0.9,                        newtype >= 0.2 && < 0.3   hs-source-dirs:      src@@ -34,7 +34,7 @@     build-depends:     base >= 4.0 && < 4.8,                        array >= 0.3 && < 0.6,                        semigroups >= 0.1 && < 0.16,-                       semigroupoids >= 1.2 && < 3.2,+                       semigroupoids >= 1.2 && < 4.1,                        vector-space >= 0.8 && < 0.9,                        newtype >= 0.2 && < 0.3, 

@@ -1,11 +1,10 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE DeriveFunctor+           , GeneralizedNewtypeDeriving+           , TypeSynonymInstances+           , MultiParamTypeClasses+           , TypeFamilies+           , FlexibleInstances+  #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -----------------------------------------------------------------------------@@ -71,10 +70,6 @@ -- 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@@ -82,23 +77,18 @@           -- ** Time and duration -         Time, Clock(..)-       , Duration, Waiting(..)+         Time, toTime, fromTime+       , Duration, toDuration, fromDuration           -- ** Eras         , Era, mkEra        , start, end, duration -         -- * Deadlines--       , Deadline(..)-          -- * Dynamic values        , Dynamic(..), mkDynamic, onDynamic         , shiftDynamic-       , transitionDeadline           -- * Active values          -- $active@@ -135,67 +125,27 @@         , (|>>), 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+import Control.Applicative+import Control.Arrow ((&&&))+import Control.Newtype -  -- | Convert a 'Duration' to any other 'Fractional' type (such as-  --   @Rational@, @Float@, or @Double@).-  fromDuration :: (FractionalOf w a) => w -> a+import Data.Array+import Data.Maybe -class Fractional a => FractionalOf v a where-        toFractionalOf :: v -> a+import Data.Functor.Apply+import Data.Semigroup hiding (First(..))+import Data.Monoid (First(..)) -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+import Data.VectorSpace hiding ((<.>))+import qualified Data.VectorSpace as VS+import Data.AffineSpace  ------------------------------------------------------------ -- Time@@ -207,29 +157,30 @@ --   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 )+  deriving ( Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac+           , AdditiveGroup+           )  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 VectorSpace Time where+  type Scalar Time = Rational+  s *^ (Time t) = Time (s * t) -instance Clock Time where-  toTime = fromRational . toRational-  fromTime = fromRational . unTime-  firstTime = min-  lastTime = max+instance InnerSpace Time where+  (Time a) <.> (Time b) = a * b -instance Fractional a => FractionalOf Time a where-  toFractionalOf (Time d) = fromRational d+-- | Convert any value of a 'Real' type (including @Int@, @Integer@,+--   @Rational@, @Float@, and @Double@) to a 'Time'.+toTime :: Real a => a -> Time+toTime = fromRational . toRational -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+-- | Convert a 'Time' to a value of any 'Fractional' type (such as+--   @Rational@, @Float@, or @Double@).+fromTime :: Fractional a => Time -> a+fromTime = fromRational . unTime  -- | An abstract type representing /elapsed time/ between two points --   in time.  Note that durations can be negative. Literal numeric@@ -249,13 +200,21 @@   type Scalar Duration = Rational   s *^ (Duration d) = Duration (s * d) -instance Waiting Duration where-  toDuration = fromRational . toRational-  fromDuration = toFractionalOf+instance AffineSpace Time where+  type Diff Time = Duration+  (Time t1) .-. (Time t2) = Duration (t1 - t2)+  (Time t) .+^ (Duration d) = Time (t + d) -instance Fractional a => FractionalOf Duration a where-  toFractionalOf (Duration d) = fromRational d+-- | Convert any value of a 'Real' type (including @Int@, @Integer@,+--   @Rational@, @Float@, and @Double@) to a 'Duration'.+toDuration :: Real a => a -> Duration+toDuration = fromRational . toRational +-- | Convert a 'Duration' to any other 'Fractional' type (such as+--   @Rational@, @Float@, or @Double@).+fromDuration :: Fractional a => Duration -> a+fromDuration = 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@@@ -265,29 +224,23 @@ -- --   @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))+newtype Era = Era (Min Time, Max Time)+  deriving (Semigroup, Show)  -- | Create an 'Era' by specifying start and end 'Time's.-mkEra :: t -> t -> Era t+mkEra :: Time -> Time -> Era mkEra s e = Era (Min s, Max e)  -- | Get the start 'Time' of an 'Era'.-start :: Era t -> t+start :: Era -> Time start (Era (Min t, _)) = t  -- | Get the end 'Time' of an 'Era'.-end :: Era t -> t+end :: Era -> Time end (Era (_, Max t)) = t  -- | Compute the 'Duration' of an 'Era'.-duration :: (Clock t) => Era t -> Diff t+duration :: Era -> Duration duration = (.-.) <$> end <*> start  ------------------------------------------------------------@@ -299,10 +252,9 @@ --   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-                           }+data Dynamic a = Dynamic { era        :: Era+                         , runDynamic :: Time -> a+                         }   deriving (Functor)  -- | 'Dynamic' is an instance of 'Apply' (/i.e./ 'Applicative' without@@ -313,28 +265,27 @@ --   '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+instance Apply Dynamic 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+instance Semigroup a => Semigroup (Dynamic 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 :: Time -> Time -> (Time -> a) -> Dynamic a mkDynamic s e = Dynamic (mkEra s e)  -- | Fold for 'Dynamic'.-onDynamic :: (t -> t -> (t -> a) -> b) -> Dynamic t a -> b+onDynamic :: (Time -> Time -> (Time -> a) -> b) -> Dynamic 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 :: Duration -> Dynamic a -> Dynamic a shiftDynamic sh =   onDynamic $ \s e d ->     mkDynamic@@ -342,10 +293,6 @@       (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 ------------------------------------------------------------@@ -371,10 +318,10 @@ -- --   The addition of constant values enable 'Monoid' and 'Applicative' --   instances for 'Active'.-newtype Active t a = Active (MaybeApply (Dynamic t) a)+newtype Active a = Active (MaybeApply Dynamic a)   deriving (Functor, Apply, Applicative) -instance Newtype (Active t a) (MaybeApply (Dynamic t) a) where+instance Newtype (Active a) (MaybeApply Dynamic a) where   pack              = Active   unpack (Active m) = m @@ -391,7 +338,7 @@ -- | 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+instance Semigroup a => Semigroup (Active a) where   (<>) = (over2 Active . over2 MaybeApply) combine    where     combine (Right m1) (Right m2)@@ -406,60 +353,56 @@     combine (Left d1) (Left d2)       = Left (d1 <> d2) -instance (Clock t, Monoid a, Semigroup a) => Monoid (Active t a) where+instance (Monoid a, Semigroup a) => Monoid (Active a) where   mempty  = Active (MaybeApply (Right mempty))   mappend = (<>)  -- | Create an 'Active' value from a 'Dynamic'.-fromDynamic :: Dynamic t a -> Active t a+fromDynamic :: Dynamic a -> Active 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 :: Time -> Time -> (Time -> a) -> Active 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 :: (a -> b) -> (Dynamic a -> b) -> Active 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 :: (a -> b) -> (Dynamic a -> Dynamic b) -> Active a -> Active 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 :: Active a -> (Time -> a) runActive = onActive const runDynamic  -- | Get the value of an @Active a@ at the beginning of its era.-activeStart :: Active t a -> a+activeStart :: Active 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 :: Active 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 :: Active a -> Maybe Era activeEra = onActive (const Nothing) (Just . era)  -- | Test whether an 'Active' value is constant.-isConstant :: Active t a -> Bool+isConstant :: Active a -> Bool isConstant = onActive (const True) (const False)  -- | Test whether an 'Active' value is 'Dynamic'.-isDynamic :: Active t a -> Bool+isDynamic :: Active 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 ------------------------------------------------------------@@ -483,44 +426,40 @@ --   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))+ui :: Fractional a => Active a+ui = interval 0 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 :: (Clock t, FractionalOf t a) => t -> t -> Active t a-interval a b = mkActive a b fromTime+interval :: Fractional a => Time -> Time -> Active a+interval a b = mkActive a b (fromRational . unTime)  -- | @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)))+stretch :: Rational -> Active a -> Active a+stretch str =+  modActive id . onDynamic $ \s e d ->+    mkDynamic s (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.--- [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)))))))+stretchTo :: Duration -> Active a -> Active a+stretchTo d a+  | d <= 0                               = a+  | (duration <$> activeEra a) == Just 0 = a+  | otherwise = maybe a (`stretch` a) ((toRational . (d /) . duration) <$> activeEra 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 :: (Deadline t a) => Active t a -> Active t a -> Active t a+during :: Active a -> Active a -> Active 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 :: Duration -> Active a -> Active a shift sh = modActive id (shiftDynamic sh)  -- | Reverse an active value so the start of its era gets mapped to@@ -528,16 +467,15 @@ --   visualized as -- --   <<http://www.cis.upenn.edu/~byorgey/hosted/backwards.png>>-backwards :: (Clock t) => Active t a -> Active t a+backwards :: Active a -> Active a backwards =   modActive id . onDynamic $ \s e d ->     mkDynamic s e-      (\t -> d (s .+^ (e .-. t)))-+      (\t -> d (e - t + s))  -- | 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 :: Time -> Active a -> Active a snapshot t a = pure (runActive a t)  -- | \"Clamp\" an active value so that it is constant before and after@@ -552,12 +490,14 @@ -- --   See also 'clampBefore' and 'clampAfter', which clamp only before --   or after the era, respectively.--clamp :: Clock t => Active t a -> Active t a+clamp :: Active a -> Active a clamp =   modActive id . onDynamic $ \s e d ->     mkDynamic s e-      (\t -> d (firstTime (lastTime t s) e))+      (\t -> case () of _ | t < s     -> d s+                          | t > e     -> d e+                          | otherwise -> d t+      )  -- | \"Clamp\" an active value so that it is constant before the start --   of its era. For example, @clampBefore 'ui'@ can be visualized as@@ -565,7 +505,7 @@ --   <<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 :: Active a -> Active a clampBefore = undefined  -- | \"Clamp\" an active value so that it is constant after the end@@ -574,7 +514,7 @@ --   <<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 :: Active a -> Active a clampAfter = undefined  -- | \"Trim\" an active value so that it is empty outside its era.@@ -592,13 +532,14 @@ -- --   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 :: Monoid a => Active a -> Active a trim =   modActive id . onDynamic $ \s e d ->     mkDynamic s e-      (\t -> choose s t (choose t e (d t) mempty) mempty)-+      (\t -> case () of _ | t < s     -> mempty+                          | t > e     -> mempty+                          | otherwise -> d t+      )  -- | \"Trim\" an active value so that it is empty /before/ the start --   of its era. For example, @trimBefore 'ui'@ can be visualized as@@ -606,11 +547,13 @@ --   <<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 :: Monoid a => Active a -> Active a trimBefore =   modActive id . onDynamic $ \s e d ->     mkDynamic s e-      (\t -> choose s t (d t) mempty)+      (\t -> case () of _ | t < s     -> mempty+                          | otherwise -> d t+      )  -- | \"Trim\" an active value so that it is empty /after/ the end --   of its era.  For example, @trimAfter 'ui'@ can be visualized as@@ -618,16 +561,18 @@ --   <<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 :: Monoid a => Active a -> Active a trimAfter =   modActive id . onDynamic $ \s e d ->     mkDynamic s e-      (\t -> choose t e (d t) mempty)+      (\t -> case () of _ | t > e     -> mempty+                          | otherwise -> d 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 t -> Active t a -> Active t a+setEra :: Era -> Active a -> Active a setEra er =   onActive     (mkActive (start er) (end er) . const)@@ -636,13 +581,13 @@ -- | @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 :: Time -> Active a -> Active 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 :: Active a -> Active a -> Active a after a1 a2 = maybe a1 ((`atTime` a1) . end) (activeEra a2)  infixr 5 ->>@@ -653,7 +598,7 @@ -- | 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+(->>) :: Semigroup a => Active a -> Active a -> Active a a1 ->> a2 = a1 <> (a2 `after` a1)  @@ -664,21 +609,17 @@ --   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+(|>>) :: Active a -> Active a -> Active a+a1 |>> 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 :: (Deadline t a) => [Active t a] -> Active t a+movie :: [Active a] -> Active a movie = foldr1 (|>>) - ------------------------------------------------------------ --  Discretization ------------------------------------------------------------@@ -691,11 +632,10 @@ --   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 :: [a] -> Active 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+discrete xs = f <$> (ui :: Active Rational)+  where f t | t <= 0    = arr ! 0             | t >= 1    = arr ! (n-1)             | otherwise = arr ! floor (t * fromIntegral n)         n   = length xs@@ -710,14 +650,12 @@ --   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 :: Rational -> Active a -> [a] simulate rate =   onActive (:[])-           (\d -> map (runDynamic d . toTime)-                      (let s, e :: Rational-                           s = fromTime $ start $ era d-                           e = fromTime $ end   $ era d+           (\d -> map (runDynamic d)+                      (let s = start (era d)+                           e = end   (era d)                        in  [s, s + 1^/rate .. e]                       )            )-

@@ -1,19 +1,18 @@-{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import           Control.Applicative-import           Control.Monad       (when)-import           Data.Semigroup+import Control.Applicative+import Control.Monad   (when)+import Data.Semigroup -import           System.Exit         (exitFailure)+import System.Exit     (exitFailure) -import           Test.QuickCheck-import           Text.Printf         (printf)+import Test.QuickCheck+import Text.Printf     (printf) -import           Data.Active-import           Data.AffineSpace-import           Data.VectorSpace+import Data.Active+import Data.VectorSpace+import Data.AffineSpace  main :: IO () main = do@@ -56,21 +55,21 @@ instance Arbitrary Duration where   arbitrary = (fromRational . abs) <$> arbitrary -instance (Clock t, Arbitrary (Diff t), CoArbitrary t, Arbitrary t, Arbitrary a) => Arbitrary (Dynamic t a) where+instance Arbitrary a => Arbitrary (Dynamic a) where   arbitrary = do     s <- arbitrary     d <- arbitrary     mkDynamic <$> pure s <*> pure (s .+^ d) <*> arbitrary -instance Show t => Show (Dynamic t a) where+instance Show (Dynamic a) where   show (Dynamic e _) = "<" ++ show e ++ ">" -instance (Clock t, Arbitrary (Diff t), CoArbitrary t, Arbitrary t, Arbitrary a) => Arbitrary (Active t a) where+instance Arbitrary a => Arbitrary (Active a) where   arbitrary = oneof [ pure <$> arbitrary                     , fromDynamic <$> arbitrary                     ] -instance (Show t, Show a) => Show (Active t a) where+instance Show a => Show (Active a) where   show = onActive (\c -> "<<" ++ show c ++ ">>")                   (\d -> show d) @@ -83,30 +82,30 @@ prop_duration :: Time -> Time -> Bool prop_duration t1 t2 = duration (mkEra t1 t2) == (t2 .-. t1) -prop_shiftDynamic_start :: Duration -> Dynamic Time Bool -> Bool+prop_shiftDynamic_start :: Duration -> Dynamic Bool -> Bool prop_shiftDynamic_start dur dyn   = (start . era) (shiftDynamic dur dyn) == ((start . era) dyn .+^ dur) -prop_shiftDynamic_end :: Duration -> Dynamic Time Bool -> Bool+prop_shiftDynamic_end :: Duration -> Dynamic Bool -> Bool prop_shiftDynamic_end dur dyn   = (end . era) (shiftDynamic dur dyn) == ((end . era) dyn .+^ dur) -prop_shiftDynamic_fun :: Duration -> Dynamic Time Bool -> Time -> Bool+prop_shiftDynamic_fun :: Duration -> Dynamic Bool -> Time -> Bool prop_shiftDynamic_fun dur dyn t   = runDynamic dyn t == runDynamic (shiftDynamic dur dyn) (t .+^ dur) -prop_active_semi_hom :: Active Time Any -> Active Time Any -> Time -> Bool+prop_active_semi_hom :: Active Any -> Active Any -> Time -> Bool prop_active_semi_hom a1 a2 t =   runActive a1 t <> runActive a2 t == runActive (a1 <> a2) t  prop_ui_id :: Time -> Bool-prop_ui_id t = runActive (ui :: Active Time Time) t == t+prop_ui_id t = runActive (ui :: Active Time) t == t -prop_stretch_start :: Rational -> Active Time Bool -> Bool+prop_stretch_start :: Rational -> Active Bool -> Bool prop_stretch_start r a   = (start <$> activeEra a) == (start <$> activeEra (stretch r a)) -prop_stretch_dur :: Rational -> Active Time Bool -> Bool+prop_stretch_dur :: Rational -> Active Bool -> Bool prop_stretch_dur r a   = (((r *^) . duration) <$> activeEra a) == (duration <$> activeEra (stretch r a)) @@ -116,41 +115,41 @@   = runActive a t    runActive (stretch r t) -} -prop_stretchTo_dur :: Positive Duration -> Active Time Bool -> Property+prop_stretchTo_dur :: Positive Duration -> Active Bool -> Property prop_stretchTo_dur (Positive dur) a   = isDynamic a && ((duration <$> activeEra a) /= Just 0)     ==> (duration <$> activeEra (stretchTo dur a)) == Just dur -prop_during_const :: Active Time Bool -> Active Time Bool -> Property+prop_during_const :: Active Bool -> Active Bool -> Property prop_during_const a1 a2 =   (isConstant a1 || isConstant a2) ==> (start <$> activeEra (a1 `during` a2)) == (start <$> activeEra a1) -prop_during_start :: Dynamic Time Bool -> Dynamic Time Bool -> Bool+prop_during_start :: Dynamic Bool -> Dynamic Bool -> Bool prop_during_start d1 d2 =   (start <$> activeEra (a1 `during` a2)) == (start <$> activeEra a2)  where a1 = fromDynamic d1        a2 = fromDynamic d2 -prop_during_end :: Dynamic Time Bool -> Dynamic Time Bool -> Bool+prop_during_end :: Dynamic Bool -> Dynamic Bool -> Bool prop_during_end d1 d2 =   (end <$> activeEra (a1 `during` a2)) == (end <$> activeEra a2)  where a1 = fromDynamic d1        a2 = fromDynamic d2 -prop_shift_start :: Duration -> Active Time Bool -> Bool+prop_shift_start :: Duration -> Active Bool -> Bool prop_shift_start d a =   ((.+^ d) . start <$> activeEra a) == (start <$> activeEra (shift d a)) -prop_shift_end :: Duration -> Active Time Bool -> Bool+prop_shift_end :: Duration -> Active Bool -> Bool prop_shift_end d a =   ((.+^ d) . end <$> activeEra a) == (end <$> activeEra (shift d a)) -prop_atTime_start :: Time -> Dynamic Time Bool -> Bool+prop_atTime_start :: Time -> Dynamic Bool -> Bool prop_atTime_start t dyn =     (start <$> activeEra (atTime t a)) == Just t   where a = fromDynamic dyn -prop_atTime_fun :: Time -> Dynamic Time Bool -> Duration -> Bool+prop_atTime_fun :: Time -> Dynamic Bool -> Duration -> Bool prop_atTime_fun t dyn d =     runActive (atTime t a) (t .+^ d) == runActive a (s .+^ d)   where a = fromDynamic dyn