diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,7 +1,9 @@ -0.1.0.19 (2 April 2015) ----------------------- +0.2.0.0 (19 April 2015) +----------------------- - - allow `vector-space-0.10` +- switch from `vector-space` to `linear` +- allow `lens-4.9` +- allow `base-4.8` 0.1.0.18 (22 Feb 2015) ---------------------- @@ -12,7 +14,7 @@ 0.1.0.17 (03 Dec 2014) ---------------------- - * Allow `semigroups-0.16` +- Allow `semigroups-0.16` 0.1.0.16 (2 June 2014) ---------------------- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,12 @@ -Copyright (c) 2011-2012, Brent Yorgey +Copyright (c) 2011-2015, active team: + +Andy Gill +Ben Gamari +Brent Yorgey +Christopher Chalmers +Daniel Bergey +Jeffrey Rosenbluth +Ryan Scott All rights reserved. diff --git a/active.cabal b/active.cabal --- a/active.cabal +++ b/active.cabal @@ -1,17 +1,17 @@ name: active -version: 0.1.0.19 +version: 0.2.0.0 synopsis: Abstractions for animation description: "Active" abstraction for animated things with finite start and end times. license: BSD3 license-file: LICENSE author: Brent Yorgey maintainer: byorgey@cis.upenn.edu -copyright: (c) 2011 Brent Yorgey +copyright: (c) 2011-2015 Brent Yorgey category: Data build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGES -tested-with: GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.1, GHC == 7.6.1 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 bug-reports: https://github.com/diagrams/active/issues source-repository head type: git @@ -20,11 +20,11 @@ library exposed-modules: Data.Active build-depends: base >= 4.0 && < 4.9, - array >= 0.3 && < 0.6, + vector >= 0.10, semigroups >= 0.1 && < 0.17, - semigroupoids >= 1.2 && < 4.4, - vector-space >= 0.8 && < 0.11, - newtype >= 0.2 && < 0.3 + semigroupoids >= 1.2 && < 5.0, + lens >= 4.0 && < 4.10, + linear >= 1.14 && < 1.19 hs-source-dirs: src default-language: Haskell2010 @@ -32,12 +32,11 @@ type: exitcode-stdio-1.0 main-is: active-tests.hs build-depends: base >= 4.0 && < 4.9, - array >= 0.3 && < 0.6, + vector >= 0.10, semigroups >= 0.1 && < 0.17, - semigroupoids >= 1.2 && < 4.4, - vector-space >= 0.8 && < 0.11, - newtype >= 0.2 && < 0.3, - + semigroupoids >= 1.2 && < 5.0, + lens >= 4.0 && < 4.9, + linear >= 1.14 && < 1.19, QuickCheck >= 2.4.2 && < 2.8 hs-source-dirs: src, test default-language: Haskell2010 diff --git a/src/Data/Active.hs b/src/Data/Active.hs --- a/src/Data/Active.hs +++ b/src/Data/Active.hs @@ -1,10 +1,16 @@ -{-# LANGUAGE DeriveFunctor - , GeneralizedNewtypeDeriving - , TypeSynonymInstances - , MultiParamTypeClasses - , TypeFamilies - , FlexibleInstances - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE UndecidableInstances #-} +-- UndecidableInstances needed for ghc < 707 {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -70,6 +76,10 @@ -- 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 @@ -77,8 +87,8 @@ -- ** Time and duration - Time, toTime, fromTime - , Duration, toDuration, fromDuration + Time + , Duration -- ** Eras @@ -132,21 +142,23 @@ ) where -import Control.Applicative -import Control.Arrow ((&&&)) -import Control.Newtype +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif -import Data.Array -import Data.Maybe +import Control.Arrow ((&&&)) +import Control.Lens hiding (backwards, (<.>)) -import Data.Functor.Apply -import Data.Semigroup hiding (First(..)) -import Data.Monoid (First(..)) +import Data.Functor.Apply +import Data.Semigroup hiding (First (..)) +import Data.Monoid (First (..)) +import qualified Data.Vector as V +import Data.Maybe -import Data.VectorSpace hiding ((<.>)) -import qualified Data.VectorSpace as VS -import Data.AffineSpace +import Linear +import Linear.Affine + ------------------------------------------------------------ -- Time ------------------------------------------------------------ @@ -156,31 +168,19 @@ -- 'Num' and 'Fractional' instances. 'toTime' and 'fromTime' are -- also provided for convenience in converting between @Time@ and -- other numeric types. -newtype Time = Time { unTime :: Rational } - deriving ( Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac - , AdditiveGroup - ) - -instance Newtype Time Rational where - pack = Time - unpack = unTime - -instance VectorSpace Time where - type Scalar Time = Rational - s *^ (Time t) = Time (s * t) +newtype Time n = Time { unTime :: n } + deriving (Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac, Functor) -instance InnerSpace Time where - (Time a) <.> (Time b) = a * b +makeWrapped ''Time --- | 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 Affine Time where + type Diff Time = Duration + (Time t1) .-. (Time t2) = Duration (t1 - t2) + (Time t) .+^ (Duration d) = Time (t + d) --- | Convert a 'Time' to a value of any 'Fractional' type (such as --- @Rational@, @Float@, or @Double@). -fromTime :: Fractional a => Time -> a -fromTime = fromRational . 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 @@ -188,32 +188,24 @@ -- 'Fractional' instances. 'toDuration' and 'fromDuration' are also -- provided for convenience in converting between @Duration@s and -- other numeric types. -newtype Duration = Duration { unDuration :: Rational } - deriving ( Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac - , AdditiveGroup) +newtype Duration n = Duration n + deriving (Eq, Ord, Show, Read, Enum, Num, Fractional, Real, RealFrac, Functor) -instance Newtype Duration Rational where - pack = Duration - unpack = unDuration +makeWrapped ''Duration -instance VectorSpace Duration where - type Scalar Duration = Rational - s *^ (Duration d) = Duration (s * d) +instance Applicative Duration where + pure = Duration + Duration f <*> Duration x = Duration (f x) -instance AffineSpace Time where - type Diff Time = Duration - (Time t1) .-. (Time t2) = Duration (t1 - t2) - (Time t) .+^ (Duration d) = Time (t + d) +instance Additive Duration where + zero = 0 --- | 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 +instance Num n => Semigroup (Duration n) where + (<>) = (^+^) --- | Convert a 'Duration' to any other 'Fractional' type (such as --- @Rational@, @Float@, or @Double@). -fromDuration :: Fractional a => Duration -> a -fromDuration = fromRational . unDuration +instance Num n => Monoid (Duration n) where + mappend = (<>) + mempty = 0 -- | 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 @@ -224,23 +216,24 @@ -- -- @Era@ is abstract. To construct @Era@ values, use 'mkEra'; to -- deconstruct, use 'start' and 'end'. -newtype Era = Era (Min Time, Max Time) - deriving (Semigroup, Show) +newtype Era n = Era (Min (Time n), Max (Time n)) + deriving (Show, Semigroup) + -- | Create an 'Era' by specifying start and end 'Time's. -mkEra :: Time -> Time -> Era +mkEra :: Time n -> Time n -> Era n mkEra s e = Era (Min s, Max e) -- | Get the start 'Time' of an 'Era'. -start :: Era -> Time +start :: Era n -> Time n start (Era (Min t, _)) = t -- | Get the end 'Time' of an 'Era'. -end :: Era -> Time +end :: Era n -> Time n end (Era (_, Max t)) = t -- | Compute the 'Duration' of an 'Era'. -duration :: Era -> Duration +duration :: Num n => Era n -> Duration n duration = (.-.) <$> end <*> start ------------------------------------------------------------ @@ -252,10 +245,11 @@ -- 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 { era :: Era - , runDynamic :: Time -> a + +data Dynamic a = Dynamic { era :: Era Rational + , runDynamic :: Time Rational -> a } - deriving (Functor) + deriving Functor -- | 'Dynamic' is an instance of 'Apply' (/i.e./ 'Applicative' without -- 'pure'): a time-varying function is applied to a time-varying @@ -265,6 +259,7 @@ -- '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 d1 f1) <.> (Dynamic d2 f2) = Dynamic (d1 <> d2) (f1 <.> f2) @@ -277,15 +272,15 @@ -- | Create a 'Dynamic' from a start time, an end time, and a -- time-varying value. -mkDynamic :: Time -> Time -> (Time -> a) -> Dynamic a +mkDynamic :: Time Rational -> Time Rational -> (Time Rational -> a) -> Dynamic a mkDynamic s e = Dynamic (mkEra s e) -- | Fold for 'Dynamic'. -onDynamic :: (Time -> Time -> (Time -> a) -> b) -> Dynamic a -> b +onDynamic :: (Time Rational -> Time Rational -> (Time Rational -> 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 :: Duration -> Dynamic a -> Dynamic a +shiftDynamic :: Duration Rational -> Dynamic a -> Dynamic a shiftDynamic sh = onDynamic $ \s e d -> mkDynamic @@ -321,37 +316,29 @@ newtype Active a = Active (MaybeApply Dynamic a) deriving (Functor, Apply, Applicative) -instance Newtype (Active a) (MaybeApply Dynamic a) where - pack = Active - unpack (Active m) = m - -instance Newtype (MaybeApply f a) (Either (f a) a) where - pack = MaybeApply - unpack = runMaybeApply +makeWrapped ''Active +makeWrapped ''MaybeApply --- | Ideally this would be defined in the @newtype@ package. If it is --- ever added we can remove it from here. -over2 :: (Newtype n o, Newtype n' o', Newtype n'' o'') - => (o -> n) -> (o -> o' -> o'') -> (n -> n' -> n'') -over2 _ f n1 n2 = pack (f (unpack n1) (unpack n2)) +active :: Iso' (Active a) (Either (Dynamic a) a) +active = _Wrapped . _Wrapped -- | 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 - (<>) = (over2 Active . over2 MaybeApply) combine + (view active -> a) <> (view active -> b) = review active $ combine a b where - combine (Right m1) (Right m2) - = Right (m1 <> m2) + combine (Right m1) (Right m2) + = Right (m1 <> m2) - combine (Left (Dynamic dur f)) (Right m) - = Left (Dynamic dur (f <> const m)) + combine (Left (Dynamic dur f)) (Right m) + = Left (Dynamic dur (f <> const m)) - combine (Right m) (Left (Dynamic dur f)) - = Left (Dynamic dur (const m <> f)) + combine (Right m) (Left (Dynamic dur f)) + = Left (Dynamic dur (const m <> f)) - combine (Left d1) (Left d2) - = Left (d1 <> d2) + combine (Left d1) (Left d2) + = Left (d1 <> d2) instance (Monoid a, Semigroup a) => Monoid (Active a) where mempty = Active (MaybeApply (Right mempty)) @@ -363,7 +350,7 @@ -- | Create a dynamic 'Active' from a start time, an end time, and a -- time-varying value. -mkActive :: Time -> Time -> (Time -> a) -> Active a +mkActive :: Time Rational -> Time Rational -> (Time Rational -> a) -> Active a mkActive s e f = fromDynamic (mkDynamic s e f) -- | Fold for 'Active's. Process an 'Active a', given a function to @@ -375,11 +362,14 @@ -- | 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 + :: (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 a -> (Time -> a) +runActive :: Active a -> Time Rational -> a runActive = onActive const runDynamic -- | Get the value of an @Active a@ at the beginning of its era. @@ -392,7 +382,7 @@ -- | Get the 'Era' of an 'Active' value (or 'Nothing' if it is -- a constant/pure value). -activeEra :: Active a -> Maybe Era +activeEra :: Active a -> Maybe (Era Rational) activeEra = onActive (const Nothing) (Just . era) -- | Test whether an 'Active' value is constant. @@ -431,7 +421,7 @@ -- | @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 -> Time -> Active a +interval :: Fractional a => Time Rational -> Time Rational -> Active a interval a b = mkActive a b (fromRational . unTime) -- | @stretch s act@ \"stretches\" the active @act@ so that it takes @@ -445,7 +435,9 @@ -- | @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 -> Active a -> Active a +-- [AJG: conditions (1) and (3) no longer true: to consider changing] + +stretchTo :: Duration Rational -> Active a -> Active a stretchTo d a | d <= 0 = a | (duration <$> activeEra a) == Just 0 = a @@ -459,7 +451,7 @@ -- | @shift d act@ shifts the start time of @act@ by duration @d@. -- Has no effect on constant values. -shift :: Duration -> Active a -> Active a +shift :: Duration Rational -> Active a -> Active a shift sh = modActive id (shiftDynamic sh) -- | Reverse an active value so the start of its era gets mapped to @@ -471,11 +463,12 @@ backwards = modActive id . onDynamic $ \s e d -> mkDynamic s e - (\t -> d (e - t + s)) + (\t -> d (s .+^ (e .-. t))) + -- | Take a \"snapshot\" of an active value at a particular time, -- resulting in a constant value. -snapshot :: Time -> Active a -> Active a +snapshot :: Time Rational -> Active a -> Active a snapshot t a = pure (runActive a t) -- | \"Clamp\" an active value so that it is constant before and after @@ -490,6 +483,7 @@ -- -- See also 'clampBefore' and 'clampAfter', which clamp only before -- or after the era, respectively. + clamp :: Active a -> Active a clamp = modActive id . onDynamic $ \s e d -> @@ -508,6 +502,8 @@ clampBefore :: Active a -> Active a clampBefore = 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 -- @@ -517,6 +513,7 @@ clampAfter :: Active a -> Active a clampAfter = undefined + -- | \"Trim\" an active value so that it is empty outside its era. -- @trim@ has no effect on constant values. -- @@ -532,6 +529,7 @@ -- -- See also 'trimBefore' and 'trimActive', which trim only before or -- after the era, respectively. + trim :: Monoid a => Active a -> Active a trim = modActive id . onDynamic $ \s e d -> @@ -541,6 +539,7 @@ | 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 -- @@ -572,7 +571,7 @@ -- | 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 -> Active a -> Active a +setEra :: Era Rational -> Active a -> Active a setEra er = onActive (mkActive (start er) (end er) . const) @@ -581,7 +580,7 @@ -- | @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 -> Active a -> Active a +atTime :: Time Rational -> 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 @@ -611,7 +610,7 @@ -- return the first. (|>>) :: Active a -> Active a -> Active a a1 |>> a2 = (fromJust . getFirst) <$> - (trimAfter (First . Just <$> a1) ->> trimBefore (First . Just <$> a2)) + (trimAfter (First . Just <$> a1) ->> trimBefore (First . Just <$> a2)) -- XXX implement 'movie' with a balanced fold @@ -634,12 +633,12 @@ -- It is an error to call @discrete@ on the empty list. discrete :: [a] -> Active a discrete [] = error "Data.Active.discrete must be called with a non-empty list." -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 - arr = listArray (0, n-1) xs +discrete xs = f <$> ui + where f (t :: Rational) + | t <= 0 = V.unsafeHead v + | t >= 1 = V.unsafeLast v + | otherwise = V.unsafeIndex v $ floor (t * fromIntegral (V.length v)) + v = V.fromList xs -- | @simulate r act@ simulates the 'Active' value @act@, returning a -- list of \"snapshots\" taken at regular intervals from the start @@ -651,6 +650,7 @@ -- times), a list of length 1 is returned, containing the constant -- value. simulate :: Rational -> Active a -> [a] +simulate 0 = const [] simulate rate = onActive (:[]) (\d -> map (runDynamic d) @@ -659,3 +659,4 @@ in [s, s + 1^/rate .. e] ) ) + diff --git a/test/active-tests.hs b/test/active-tests.hs --- a/test/active-tests.hs +++ b/test/active-tests.hs @@ -1,26 +1,32 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import Control.Applicative -import Control.Monad (when) -import Data.Semigroup +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif -import System.Exit (exitFailure) +import Control.Monad (unless) +import Data.Semigroup -import Test.QuickCheck -import Text.Printf (printf) +import System.Exit (exitFailure) -import Data.Active -import Data.VectorSpace -import Data.AffineSpace +import Test.QuickCheck +import Text.Printf (printf) +import Data.Active + +import Linear.Affine +import Linear.Vector + main :: IO () main = do - results <- mapM (\(s,t) -> printf "%-40s" s >> t) tests - when (not . all isSuccess $ results) $ exitFailure + results <- mapM (\(s,t) -> printf "%-40s" s >> t) tests + unless (all isSuccess results) exitFailure where isSuccess (Success{}) = True - isSuccess _ = False + isSuccess _ = False qc x = quickCheckWithResult (stdArgs { maxSuccess = 200 }) x tests = [ ("era/start", qc prop_era_start ) , ("era/end", qc prop_era_end ) @@ -42,17 +48,19 @@ , ("atTime/start", qc prop_atTime_start ) , ("atTime/fun", qc prop_atTime_fun ) ] +{-# ANN main ("HLint: ignore Eta reduce" :: String) #-} +-- eta reducing qc breaks it instance Arbitrary Any where arbitrary = Any <$> arbitrary -instance Arbitrary Time where +instance (Arbitrary n, Fractional n, Real n) => Arbitrary (Time n) where arbitrary = fromRational <$> arbitrary -instance CoArbitrary Time where +instance (CoArbitrary n, Real n) => CoArbitrary (Time n) where coarbitrary t = coarbitrary (toRational t) -instance Arbitrary Duration where +instance (Arbitrary n, Fractional n, Real n) => Arbitrary (Duration n) where arbitrary = (fromRational . abs) <$> arbitrary instance Arbitrary a => Arbitrary (Dynamic a) where @@ -71,35 +79,35 @@ instance Show a => Show (Active a) where show = onActive (\c -> "<<" ++ show c ++ ">>") - (\d -> show d) + show -prop_era_start :: Time -> Time -> Bool +prop_era_start :: Time Rational -> Time Rational -> Bool prop_era_start t1 t2 = start (mkEra t1 t2) == t1 -prop_era_end :: Time -> Time -> Bool +prop_era_end :: Time Rational -> Time Rational -> Bool prop_era_end t1 t2 = end (mkEra t1 t2) == t2 -prop_duration :: Time -> Time -> Bool +prop_duration :: Time Rational -> Time Rational -> Bool prop_duration t1 t2 = duration (mkEra t1 t2) == (t2 .-. t1) -prop_shiftDynamic_start :: Duration -> Dynamic Bool -> Bool +prop_shiftDynamic_start :: Duration Rational -> Dynamic Bool -> Bool prop_shiftDynamic_start dur dyn = (start . era) (shiftDynamic dur dyn) == ((start . era) dyn .+^ dur) -prop_shiftDynamic_end :: Duration -> Dynamic Bool -> Bool +prop_shiftDynamic_end :: Duration Rational -> Dynamic Bool -> Bool prop_shiftDynamic_end dur dyn = (end . era) (shiftDynamic dur dyn) == ((end . era) dyn .+^ dur) -prop_shiftDynamic_fun :: Duration -> Dynamic Bool -> Time -> Bool +prop_shiftDynamic_fun :: Duration Rational -> Dynamic Bool -> Time Rational -> Bool prop_shiftDynamic_fun dur dyn t = runDynamic dyn t == runDynamic (shiftDynamic dur dyn) (t .+^ dur) -prop_active_semi_hom :: Active Any -> Active Any -> Time -> Bool +prop_active_semi_hom :: Active Any -> Active Any -> Time Rational -> 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) t == t +prop_ui_id :: Time Rational -> Bool +prop_ui_id t = runActive (ui :: Active (Time Rational)) t == t prop_stretch_start :: Rational -> Active Bool -> Bool prop_stretch_start r a @@ -115,7 +123,7 @@ = runActive a t runActive (stretch r t) -} -prop_stretchTo_dur :: Positive Duration -> Active Bool -> Property +prop_stretchTo_dur :: Positive (Duration Rational) -> Active Bool -> Property prop_stretchTo_dur (Positive dur) a = isDynamic a && ((duration <$> activeEra a) /= Just 0) ==> (duration <$> activeEra (stretchTo dur a)) == Just dur @@ -136,20 +144,20 @@ where a1 = fromDynamic d1 a2 = fromDynamic d2 -prop_shift_start :: Duration -> Active Bool -> Bool +prop_shift_start :: Duration Rational -> Active Bool -> Bool prop_shift_start d a = ((.+^ d) . start <$> activeEra a) == (start <$> activeEra (shift d a)) -prop_shift_end :: Duration -> Active Bool -> Bool +prop_shift_end :: Duration Rational -> Active Bool -> Bool prop_shift_end d a = ((.+^ d) . end <$> activeEra a) == (end <$> activeEra (shift d a)) -prop_atTime_start :: Time -> Dynamic Bool -> Bool +prop_atTime_start :: Time Rational -> Dynamic Bool -> Bool prop_atTime_start t dyn = (start <$> activeEra (atTime t a)) == Just t where a = fromDynamic dyn -prop_atTime_fun :: Time -> Dynamic Bool -> Duration -> Bool +prop_atTime_fun :: Time Rational -> Dynamic Bool -> Duration Rational -> Bool prop_atTime_fun t dyn d = runActive (atTime t a) (t .+^ d) == runActive a (s .+^ d) where a = fromDynamic dyn