module Music.Time.Stretched (
Stretched,
stretched,
stretchedValue,
) where
import Data.AffineSpace
import Data.AffineSpace.Point
import Data.Bifunctor
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ratio
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as Set
import Data.VectorSpace
import Data.Functor.Couple
import Music.Time.Reverse
import Music.Time.Split
import Control.Applicative
import Control.Comonad
import Control.Comonad.Env
import Control.Lens hiding (Indexable, Level, above, below,
index, inside, parts, reversed,
transform, (<|), (|>))
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Data.PairMonad
import Data.Typeable
newtype Stretched a = Stretched { _stretchedValue :: Couple Duration a }
deriving (Applicative, Monad,
Functor, Foldable, Traversable)
deriving instance Traversable (Couple a)
deriving instance Eq a => Eq (Stretched a)
deriving instance Num a => Num (Stretched a)
deriving instance Fractional a => Fractional (Stretched a)
deriving instance Floating a => Floating (Stretched a)
deriving instance Ord a => Ord (Stretched a)
deriving instance Real a => Real (Stretched a)
deriving instance RealFrac a => RealFrac (Stretched a)
deriving instance Typeable1 Stretched
instance Wrapped (Stretched a) where
type Unwrapped (Stretched a) = (Duration, a)
_Wrapped' = iso (getCouple . _stretchedValue) (Stretched . Couple)
instance Rewrapped (Stretched a) (Stretched b)
instance Transformable (Stretched a) where
transform t = over _Wrapped $ first (transform t)
instance HasDuration (Stretched a) where
_duration = _duration . ask . view _Wrapped
instance Reversible (Stretched a) where
rev = stretch (1)
instance Splittable a => Splittable (Stretched a) where
beginning d = over _Wrapped $ \(s, v) -> (beginning d s, beginning d v)
ending d = over _Wrapped $ \(s, v) -> (ending d s, ending d v)
deriving instance Show a => Show (Stretched a)
stretched :: Iso (Duration, a) (Duration, b) (Stretched a) (Stretched b)
stretched = _Unwrapped
stretchedValue :: (Transformable a, Transformable b) => Lens (Stretched a) (Stretched b) a b
stretchedValue = lens runStretched (flip $ _stretched . const)
where
_stretched f (Stretched (Couple (d, x))) = Stretched (Couple (d, f `whilst` stretching d $ x))
runStretched :: Transformable a => Stretched a -> a
runStretched = uncurry stretch . view _Wrapped