active 0.1.0.19 → 0.2.0.0

raw patch · 5 files changed

+179/−161 lines, 5 filesdep +lensdep +lineardep +vectordep −arraydep −newtypedep −vector-spacedep ~semigroupoidsPVP ok

version bump matches the API change (PVP)

Dependencies added: lens, linear, vector

Dependencies removed: array, newtype, vector-space

Dependency ranges changed: semigroupoids

API changes (from Hackage documentation)

Files

• CHANGES +6/−4
• LICENSE +9/−1
• active.cabal +11/−12
• src/Data/Active.hs +115/−114
• test/active-tests.hs +38/−30

@@ -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) ----------------------

@@ -1,4 +1,12 @@-Copyright (c) 2011-2012, Brent Yorgey+Copyright (c) 2011-2015, active team:++Andy Gill <andygill@ku.edu>+Ben Gamari <ben@smart-cactus.org>+Brent Yorgey <byorgey@gmail.com>+Christopher Chalmers <c.chalmers@me.com>+Daniel Bergey <bergey@alum.mit.edu>+Jeffrey Rosenbluth <jeffrey.rosenbluth@gmail.com>+Ryan Scott <ryan.gl.scott@ku.edu>  All rights reserved. 

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

@@ -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]                       )            )+

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