mediabus-0.4.0.1: Multimedia streaming on top of Conduit

Safe HaskellNone
LanguageHaskell2010

Data.MediaBus.Basics.Ticks

Description

This module contains the Ticks time unit as well as the corresponding known-at-compile-time StaticTicks time unit. The time stamps are given as quotient of a Rate that indicates the number of Ticks per second.

Synopsis

Documentation

newtype Rate Source #

The known at ompile time, time unit in units per second.

Constructors

Hertz Nat 

type Hz r = Hertz r Source #

A more beautiful operator for Hertz

type OnePerPicoSecond = Hz 1000000000000 Source #

The maximum representable frequency is 10e12 1/s which corresponds to the resolution of NominalDiffTime, i.e. 1 pico second.

class KnownRate s where Source #

Analogous to KnownNat this (kind-)class is for StaticTicks with a runtime Ticks value.

Minimal complete definition

rateVal

Associated Types

type RateVal s :: Nat Source #

Return the compile time rate value in Hertz

Methods

rateVal :: proxy s -> Integer Source #

Return the runtime rate value in Hertz

Instances

KnownNat r => KnownRate (Hertz r) Source # 

Associated Types

type RateVal (Hertz r :: Rate) :: Nat Source #

Methods

rateVal :: proxy (Hertz r) -> Integer Source #

class (KnownRate (GetRate i), SetRate i (GetRate i) ~ i) => HasRate i Source #

Types with a known Rate, e.g. audio media has a sample rate.

Associated Types

type SetRate i (r :: Rate) Source #

Set the static sample rate of the media

type GetRate i :: Rate Source #

The static sample rate of the media

Instances

HasRate c => HasRate (Discontinous c) Source # 

Associated Types

type SetRate (Discontinous c) (r :: Rate) :: * Source #

type GetRate (Discontinous c) :: Rate Source #

HasRate c => HasRate (Segment d c) Source # 

Associated Types

type SetRate (Segment d c) (r :: Rate) :: * Source #

type GetRate (Segment d c) :: Rate Source #

KnownRate r => HasRate (Audio r c t) Source # 

Associated Types

type SetRate (Audio r c t) (r :: Rate) :: * Source #

type GetRate (Audio r c t) :: Rate Source #

class (HasRate i, GetRate i ~ ri, SetRate i rj ~ j, KnownRate rj) => CoerceRate i j ri rj where Source #

Types which contain a rate, but are agnostic of it. The counter example would be if the rate was a type index of a data family.

Minimal complete definition

coerceRate

Methods

coerceRate :: proxy rj -> i -> SetRate i rj Source #

Change the static sample rate, without e.g. resampling

Instances

(HasRate i, (~) Rate (GetRate i) ri, (~) * (SetRate i rj) j, KnownRate rj, CoerceRate i j ri rj) => CoerceRate (Discontinous i) (Discontinous j) ri rj Source # 

Methods

coerceRate :: proxy rj -> Discontinous i -> SetRate (Discontinous i) rj Source #

(HasRate i, (~) Rate (GetRate i) ri, (~) * (SetRate i rj) j, KnownRate rj, CoerceRate i j ri rj) => CoerceRate (Segment d i) (Segment d j) ri rj Source # 

Methods

coerceRate :: proxy rj -> Segment d i -> SetRate (Segment d i) rj Source #

getRate :: forall i proxy. HasRate i => proxy i -> Integer Source #

Return the Rate as an Integer from a proxy for an instance of HasRate

getRateProxy :: HasRate i => proxy i -> RateProxy (GetRate i) Source #

Return a Proxy for the GetRate from a proxy for an instance of HasRate

data RateProxy :: Rate -> Type where Source #

A proxy type for Rates useful to prevent orphan instances, is seen in the Show instance for RateProxy. If the instance were defined as instance KnownRate r => Show (proxy r) where ... it would be an orphan instance.

Constructors

MkRateProxy :: RateProxy rate 
ConvertRateProxy :: proxy rate -> RateProxy rate 

Instances

type PeriodDuration i = 1 :/ GetRate i Source #

Return the StaticTicks representing the shortest representable duration of something sampled at a Rate

getPeriodDuration :: forall i proxy. HasRate i => proxy i -> NominalDiffTime Source #

Return the reciprocal of the sample rate, i.e. the duration that one sample spans

coerceRateTo8kHz :: CoerceRate x y rx (Hz 8000) => x -> y Source #

Utility around coerceRate to set the sample rate to 8000 Hz.

coerceRateTo16kHz :: CoerceRate x y rx (Hz 16000) => x -> y Source #

Utility around coerceRate to set the sample rate to 16000 Hz.

coerceRateTo48kHz :: CoerceRate x y rx (Hz 48000) => x -> y Source #

Utility around coerceRate to set the sample rate to 48000 Hz.

coerceToDoubleRate :: forall r s x y. (CoerceRate x y r (Hz (s + s)), KnownRate r, RateVal r ~ s, KnownNat (s + s)) => x -> y Source #

Utility around coerceRate to double the sample rate.

newtype Ticks rate w Source #

An integral time unit such that (time_in_seconds = _ticks * 1/rate)

Constructors

MkTicks w 

Instances

Enum w => Enum (Ticks rate w) Source # 

Methods

succ :: Ticks rate w -> Ticks rate w #

pred :: Ticks rate w -> Ticks rate w #

toEnum :: Int -> Ticks rate w #

fromEnum :: Ticks rate w -> Int #

enumFrom :: Ticks rate w -> [Ticks rate w] #

enumFromThen :: Ticks rate w -> Ticks rate w -> [Ticks rate w] #

enumFromTo :: Ticks rate w -> Ticks rate w -> [Ticks rate w] #

enumFromThenTo :: Ticks rate w -> Ticks rate w -> Ticks rate w -> [Ticks rate w] #

Eq w => Eq (Ticks rate w) Source # 

Methods

(==) :: Ticks rate w -> Ticks rate w -> Bool #

(/=) :: Ticks rate w -> Ticks rate w -> Bool #

(LocalOrd w, Integral w) => Integral (Ticks rate w) Source # 

Methods

quot :: Ticks rate w -> Ticks rate w -> Ticks rate w #

rem :: Ticks rate w -> Ticks rate w -> Ticks rate w #

div :: Ticks rate w -> Ticks rate w -> Ticks rate w #

mod :: Ticks rate w -> Ticks rate w -> Ticks rate w #

quotRem :: Ticks rate w -> Ticks rate w -> (Ticks rate w, Ticks rate w) #

divMod :: Ticks rate w -> Ticks rate w -> (Ticks rate w, Ticks rate w) #

toInteger :: Ticks rate w -> Integer #

Num w => Num (Ticks rate w) Source # 

Methods

(+) :: Ticks rate w -> Ticks rate w -> Ticks rate w #

(-) :: Ticks rate w -> Ticks rate w -> Ticks rate w #

(*) :: Ticks rate w -> Ticks rate w -> Ticks rate w #

negate :: Ticks rate w -> Ticks rate w #

abs :: Ticks rate w -> Ticks rate w #

signum :: Ticks rate w -> Ticks rate w #

fromInteger :: Integer -> Ticks rate w #

(Eq w, LocalOrd w) => Ord (Ticks rate w) Source # 

Methods

compare :: Ticks rate w -> Ticks rate w -> Ordering #

(<) :: Ticks rate w -> Ticks rate w -> Bool #

(<=) :: Ticks rate w -> Ticks rate w -> Bool #

(>) :: Ticks rate w -> Ticks rate w -> Bool #

(>=) :: Ticks rate w -> Ticks rate w -> Bool #

max :: Ticks rate w -> Ticks rate w -> Ticks rate w #

min :: Ticks rate w -> Ticks rate w -> Ticks rate w #

(LocalOrd w, Real w) => Real (Ticks rate w) Source # 

Methods

toRational :: Ticks rate w -> Rational #

(CanBeTicks r w, Show w) => Show (Ticks r w) Source # 

Methods

showsPrec :: Int -> Ticks r w -> ShowS #

show :: Ticks r w -> String #

showList :: [Ticks r w] -> ShowS #

Generic (Ticks rate w) Source # 

Associated Types

type Rep (Ticks rate w) :: * -> * #

Methods

from :: Ticks rate w -> Rep (Ticks rate w) x #

to :: Rep (Ticks rate w) x -> Ticks rate w #

Arbitrary w => Arbitrary (Ticks rate w) Source # 

Methods

arbitrary :: Gen (Ticks rate w) #

shrink :: Ticks rate w -> [Ticks rate w] #

Default w => Default (Ticks rate w) Source # 

Methods

def :: Ticks rate w #

NFData w => NFData (Ticks rate w) Source # 

Methods

rnf :: Ticks rate w -> () #

Random w => Random (Ticks rate w) Source # 

Methods

randomR :: RandomGen g => (Ticks rate w, Ticks rate w) -> g -> (Ticks rate w, g) #

random :: RandomGen g => g -> (Ticks rate w, g) #

randomRs :: RandomGen g => (Ticks rate w, Ticks rate w) -> g -> [Ticks rate w] #

randoms :: RandomGen g => g -> [Ticks rate w] #

randomRIO :: (Ticks rate w, Ticks rate w) -> IO (Ticks rate w) #

randomIO :: IO (Ticks rate w) #

LocalOrd w => LocalOrd (Ticks rate w) Source # 

Methods

succeeds :: Ticks rate w -> Ticks rate w -> Bool Source #

type Rep (Ticks rate w) Source # 
type Rep (Ticks rate w) = D1 (MetaData "Ticks" "Data.MediaBus.Basics.Ticks" "mediabus-0.4.0.1-KxOztWIrQ7SL9k5ZMcQI4H" True) (C1 (MetaCons "MkTicks" PrefixI True) (S1 (MetaSel (Just Symbol "_ticks") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 w)))

type CanBeTicks r w = (KnownRate r, Integral w) Source #

The constraint on the type parameters of 'Ticks

type PicoSeconds = Ticks OnePerPicoSecond Integer Source #

The highest resolution Ticks possible, such that it can still be converted to NominalDiffTime

type Ticks32 r = Ticks r Word32 Source #

Alias for Ticks based on a Word32 tick count.

mkTicks32 :: KnownRate r => proxy r -> Word32 -> Ticks32 r Source #

Create a Ticks32 from a Rate given via a proxy and the number of ticks.

type Ticks64 r = Ticks r Word64 Source #

Alias for Ticks based on a Word64 tick count.

mkTicks64 :: KnownRate r => proxy r -> Word64 -> Ticks64 r Source #

Create a Ticks64 from a Rate given via a proxy and the number of ticks.

type Ticks32At8000 = Ticks32 (Hz 8000) Source #

Alias for Ticks based on a Word32 tick count with a rate of 8000 ticks per second.

mkTicks32At8000 :: Word32 -> Ticks32At8000 Source #

Create a Ticks32At8000 from a tick count.

type Ticks32At16000 = Ticks32 (Hz 16000) Source #

Alias for Ticks based on a Word32 tick count with a rate of 16000 ticks per second.

mkTicks32At16000 :: Word32 -> Ticks32At16000 Source #

Create a 'Ticks32At16000 from a tick count.

type Ticks32At48000 = Ticks32 (Hz 48000) Source #

Alias for Ticks based on a Word32 tick count with a rate of 48000 ticks per second.

mkTicks32At48000 :: Word32 -> Ticks32At48000 Source #

Create a 'Ticks32At48000 from a tick count.

type Ticks64At8000 = Ticks64 (Hz 8000) Source #

Alias for Ticks based on a Word64 tick count with a rate of 8000 ticks per second.

mkTicks64At8000 :: Word64 -> Ticks64At8000 Source #

Create a 'Ticks64At8000 from a tick count.

type Ticks64At16000 = Ticks64 (Hz 16000) Source #

Alias for Ticks based on a Word64 tick count with a rate of 16000 ticks per second.

mkTicks64At16000 :: Word64 -> Ticks64At16000 Source #

Create a 'Ticks64At16000 from a tick count.

type Ticks64At48000 = Ticks64 (Hz 48000) Source #

Alias for Ticks based on a Word64 tick count with a rate of 48000 ticks per second.

mkTicks64At48000 :: Word64 -> Ticks64At48000 Source #

Create a 'Ticks64At48000 from a tick count.

nominalDiffTime :: forall r w. CanBeTicks r w => Iso' (Ticks r w) NominalDiffTime Source #

A function (an Iso) that converts back-and-forth between Ticks and NominalDiffTimes

convertTicks :: (CanBeTicks r w, CanBeTicks r' w') => Ticks r w -> Ticks r' w' Source #

Transform a Tick value to another Tick value.

data StaticTicks where Source #

Time unit for durations known at compile time.

Constructors

(:/:) :: Nat -> Rate -> StaticTicks 

Instances

(KnownRate r, KnownNat t) => HasStaticDuration StaticTicks ((:/) t r) Source # 

Associated Types

type SetStaticDuration ((:/) t r) (s :: (:/) t r) (pt :: StaticTicks) :: k Source #

type GetStaticDuration ((:/) t r) (s :: (:/) t r) :: StaticTicks Source #

type GetStaticDuration StaticTicks ((:/) t r) Source # 
type SetStaticDuration StaticTicks ((:/) t r) ((:/) t' r') Source # 
type SetStaticDuration StaticTicks ((:/) t r) ((:/) t' r') = (:/) t' r'

class KnownStaticTicks s where Source #

Analog to KnownNat this (kind-)class is for StaticTicks with a runtime Ticks value.

Minimal complete definition

staticTicksVal

Methods

staticTicksVal :: KnownRate r => proxy s -> Ticks r Integer Source #

Instances

(KnownNat d, KnownRate r) => KnownStaticTicks ((:/) d r) Source # 

Methods

staticTicksVal :: KnownRate r => proxy (d :/ r) -> Ticks r Integer Source #

type family StaticTicksRate (s :: StaticTicks) :: Rate where ... Source #

Return the Rate value of a promoted StaticTicks.

Equations

StaticTicksRate (t :/ r) = r 

type family StaticTicksTicks (s :: StaticTicks) :: Nat where ... Source #

Return the ticks value of a promoted StaticTicks.

Equations

StaticTicksTicks (t :/ r) = t 

class HasDuration a where Source #

Types with a duration (e.g. audio samples).

class SetTimestamp t (GetTimestamp t) ~ t => HasTimestamp t where Source #

Types that contain a Timestamp

Minimal complete definition

timestamp

Associated Types

type GetTimestamp t Source #

type SetTimestamp t s Source #

Instances

(HasTimestamp a, HasTimestamp b, (~) * (GetTimestamp a) (GetTimestamp b)) => HasTimestamp (Series a b) Source # 

Associated Types

type GetTimestamp (Series a b) :: * Source #

type SetTimestamp (Series a b) s :: * Source #

Methods

timestamp :: Functor f => (GetTimestamp (Series a b) -> f s) -> Series a b -> f (SetTimestamp (Series a b) s) Source #

timestamp' :: Lens' (Series a b) (GetTimestamp (Series a b)) Source #

HasTimestamp (Frame s t c) Source # 

Associated Types

type GetTimestamp (Frame s t c) :: * Source #

type SetTimestamp (Frame s t c) s :: * Source #

Methods

timestamp :: Functor f => (GetTimestamp (Frame s t c) -> f s) -> Frame s t c -> f (SetTimestamp (Frame s t c) s) Source #

timestamp' :: Lens' (Frame s t c) (GetTimestamp (Frame s t c)) Source #

HasTimestamp (FrameCtx i s t p) Source # 

Associated Types

type GetTimestamp (FrameCtx i s t p) :: * Source #

type SetTimestamp (FrameCtx i s t p) s :: * Source #

Methods

timestamp :: Functor f => (GetTimestamp (FrameCtx i s t p) -> f s) -> FrameCtx i s t p -> f (SetTimestamp (FrameCtx i s t p) s) Source #

timestamp' :: Lens' (FrameCtx i s t p) (GetTimestamp (FrameCtx i s t p)) Source #

HasTimestamp (Stream i s t p c) Source # 

Associated Types

type GetTimestamp (Stream i s t p c) :: * Source #

type SetTimestamp (Stream i s t p c) s :: * Source #

Methods

timestamp :: Functor f => (GetTimestamp (Stream i s t p c) -> f s) -> Stream i s t p c -> f (SetTimestamp (Stream i s t p c) s) Source #

timestamp' :: Lens' (Stream i s t p c) (GetTimestamp (Stream i s t p c)) Source #

setTimestampFromDurations :: forall r t a. (CanBeTicks r t, HasDuration a, HasTimestamp a, GetTimestamp a ~ ()) => a -> Ticks r t -> (SetTimestamp a (Ticks r t), Ticks r t) Source #

Calculate and set a timestamp.

The timestamp of each element is calculated from the sum of the durations of the previous elements stored and the start time stamp t0.

The input elements must be instances of HasTimestamp but with the important condition, that the input timestamp is always unit i.e. (). This prevents meaningful timestamps from being overwritten.

Use removeTimestamp to explicitly remove a timestamp.

removeTimestamp :: HasTimestamp a => a -> SetTimestamp a () Source #

Explicitly remove a timestamp, by setting the timestamp to ().

class (KnownStaticTicks (GetStaticDuration s), SetStaticDuration s (GetStaticDuration s) ~ s) => HasStaticDuration s Source #

Types that have a duration known at compoile time.

Associated Types

type SetStaticDuration s (pt :: StaticTicks) :: k Source #

type GetStaticDuration s :: StaticTicks Source #

Instances

(KnownRate r, KnownNat t) => HasStaticDuration StaticTicks ((:/) t r) Source # 

Associated Types

type SetStaticDuration ((:/) t r) (s :: (:/) t r) (pt :: StaticTicks) :: k Source #

type GetStaticDuration ((:/) t r) (s :: (:/) t r) :: StaticTicks Source #

KnownStaticTicks d => HasStaticDuration * (Segment d x) Source # 

Associated Types

type SetStaticDuration (Segment d x) (s :: Segment d x) (pt :: StaticTicks) :: k Source #

type GetStaticDuration (Segment d x) (s :: Segment d x) :: StaticTicks Source #

getStaticDurationTicks :: forall proxy s r t i. (CanBeTicks r i, KnownNat t, HasStaticDuration s, GetStaticDuration s ~ (t :/ r)) => proxy s -> Ticks r i Source #

Convert the StaticDuration that some type has to any Ticks.

getStaticDuration :: forall proxy s. HasStaticDuration s => proxy s -> NominalDiffTime Source #

Convert the StaticDuration that some type has to the number of seconds.

toStaticDurationProxy :: HasStaticDuration s => proxy s -> Proxy (GetStaticDuration s) Source #

Create a Proxy for the StaticTicks type associated with s, this is basically the analogon to the getDuration method - just for types with a duration known at compile time.

ticksFromStaticDuration :: forall proxy rate ticks i. (CanBeTicks rate i, KnownNat ticks) => proxy (ticks :/ rate) -> Ticks rate i Source #

type (:/) ticks rate = ticks :/: rate Source #

Convenient wrapper around MkStaticTicks and MkRate to create a promoted StaticTicks.