module Data.MediaBus.Basics.Ticks
( Rate(..)
, type Hz
, type OnePerPicoSecond
, KnownRate(..)
, HasRate(..)
, CoerceRate(..)
, getRate
, getRateProxy
, RateProxy(..)
, type PeriodDuration
, getPeriodDuration
, coerceRateTo8kHz
, coerceRateTo16kHz
, coerceRateTo48kHz
, coerceToDoubleRate
, Ticks(..)
, CanBeTicks
, type PicoSeconds
, type Ticks32
, mkTicks32
, type Ticks64
, mkTicks64
, type Ticks32At8000
, mkTicks32At8000
, type Ticks32At16000
, mkTicks32At16000
, type Ticks32At48000
, mkTicks32At48000
, type Ticks64At8000
, mkTicks64At8000
, type Ticks64At16000
, mkTicks64At16000
, type Ticks64At48000
, mkTicks64At48000
, nominalDiffTime
, convertTicks
, StaticTicks(..)
, KnownStaticTicks(..)
, type StaticTicksRate
, type StaticTicksTicks
, HasDuration(..)
, HasTimestamp(..)
, HasStaticDuration(..)
, getStaticDurationTicks
, getStaticDuration
, toStaticDurationProxy
, ticksFromStaticDuration
, (:/)
) where
import Control.DeepSeq
import Control.Lens
import Data.Default
import Data.Kind
import Data.MediaBus.Basics.Monotone
import Data.MediaBus.Basics.Series
import Data.Proxy
import Data.Time.Clock
import Data.Word
import GHC.Generics (Generic)
import GHC.TypeLits
import System.Random
import Test.QuickCheck
import Text.Printf
newtype Rate =
Hertz Nat
type Hz r = 'Hertz r
class KnownRate (s :: Rate) where
rateVal :: proxy s -> Integer
type RateVal s :: Nat
instance (KnownNat r) =>
KnownRate ('Hertz r) where
rateVal _ = natVal (Proxy :: Proxy r)
type RateVal ('Hertz r) = r
data RateProxy :: Rate -> Type where
MkRateProxy :: RateProxy rate
ConvertRateProxy :: proxy rate -> RateProxy rate
instance KnownRate r =>
Show (RateProxy r) where
showsPrec p _ =
showParen (p > 10) (shows (rateVal (Proxy :: Proxy r)) . showString " Hz")
type PeriodDuration i = 1 :/ GetRate i
type OnePerPicoSecond = Hz 1000000000000
class (KnownRate (GetRate i), SetRate i (GetRate i) ~ i) =>
HasRate i where
type SetRate i (r :: Rate)
type GetRate i :: Rate
class (HasRate i, GetRate i ~ ri, SetRate i rj ~ j, KnownRate rj) =>
CoerceRate i j ri rj
where
coerceRate :: proxy rj -> i -> SetRate i rj
getRate
:: forall i proxy.
HasRate i
=> proxy i -> Integer
getRate = rateVal . getRateProxy
getRateProxy
:: HasRate i
=> proxy i -> RateProxy (GetRate i)
getRateProxy _ = MkRateProxy
getPeriodDuration
:: forall i proxy.
HasRate i
=> proxy i -> NominalDiffTime
getPeriodDuration _ = 1 / fromInteger (rateVal (Proxy :: Proxy (GetRate i)))
coerceRateTo8kHz
:: CoerceRate x y rx (Hz 8000)
=> x -> y
coerceRateTo8kHz = coerceRate (Proxy :: Proxy (Hz 8000))
coerceRateTo16kHz
:: CoerceRate x y rx (Hz 16000)
=> x -> y
coerceRateTo16kHz = coerceRate (Proxy :: Proxy (Hz 16000))
coerceRateTo48kHz
:: CoerceRate x y rx (Hz 48000)
=> x -> y
coerceRateTo48kHz = coerceRate (Proxy :: Proxy (Hz 48000))
coerceToDoubleRate
:: forall r s x y.
( CoerceRate x y r (Hz (s + s))
, KnownRate r
, RateVal r ~ s
, KnownNat (s + s)
)
=> x -> y
coerceToDoubleRate = coerceRate (Proxy :: Proxy (Hz (s + s)))
newtype Ticks (rate :: Rate) w = MkTicks
{ _ticks :: w
} deriving ( Eq
, Real
, Integral
, Enum
, LocalOrd
, Num
, Arbitrary
, Default
, Generic
, Random
)
type CanBeTicks (r :: Rate) w = (KnownRate r, Integral w)
type PicoSeconds = Ticks OnePerPicoSecond Integer
type Ticks32 r = Ticks r Word32
mkTicks32
:: KnownRate r
=> proxy r -> Word32 -> Ticks32 r
mkTicks32 _ = MkTicks
type Ticks64 r = Ticks r Word64
mkTicks64
:: KnownRate r
=> proxy r -> Word64 -> Ticks64 r
mkTicks64 _ = MkTicks
type Ticks32At8000 = Ticks32 (Hz 8000)
mkTicks32At8000 :: Word32 -> Ticks32At8000
mkTicks32At8000 = MkTicks
type Ticks32At16000 = Ticks32 (Hz 16000)
mkTicks32At16000 :: Word32 -> Ticks32At16000
mkTicks32At16000 = MkTicks
type Ticks32At48000 = Ticks32 (Hz 48000)
mkTicks32At48000 :: Word32 -> Ticks32At48000
mkTicks32At48000 = MkTicks
type Ticks64At8000 = Ticks64 (Hz 8000)
mkTicks64At8000 :: Word64 -> Ticks64At8000
mkTicks64At8000 = MkTicks
type Ticks64At16000 = Ticks64 (Hz 16000)
mkTicks64At16000 :: Word64 -> Ticks64At16000
mkTicks64At16000 = MkTicks
type Ticks64At48000 = Ticks64 (Hz 48000)
mkTicks64At48000 :: Word64 -> Ticks64At48000
mkTicks64At48000 = MkTicks
instance NFData w =>
NFData (Ticks rate w)
convertTicks
:: (CanBeTicks r w, CanBeTicks r' w')
=> Ticks r w -> Ticks r' w'
convertTicks = view (from nominalDiffTime) . view nominalDiffTime
nominalDiffTime
:: forall r w.
(CanBeTicks r w)
=> Iso' (Ticks r w) NominalDiffTime
nominalDiffTime = iso (toNDT . _ticks) (MkTicks . fromNDT)
where
toNDT = (/ rate) . fromIntegral
fromNDT = round . (* rate)
rate = fromInteger $ rateVal (Proxy :: Proxy r)
instance (CanBeTicks r w, Show w) =>
Show (Ticks r w) where
show tix@(MkTicks x) =
printf
"%10s (%10d @ %10d Hz)"
(show (view nominalDiffTime tix))
(toInteger x)
(rateVal (Proxy :: Proxy r))
instance (Eq w, LocalOrd w) =>
Ord (Ticks rate w) where
(<=) = flip succeeds
data StaticTicks where
(:/:) :: Nat -> Rate -> StaticTicks
type ticks :/ rate = ticks ':/: rate
type family StaticTicksRate (s :: StaticTicks) :: Rate where
StaticTicksRate (t :/ r) = r
type family StaticTicksTicks (s :: StaticTicks) :: Nat where
StaticTicksTicks (t :/ r) = t
class KnownStaticTicks (s :: StaticTicks) where
staticTicksVal
:: KnownRate r
=> proxy s -> Ticks r Integer
instance (KnownNat d, KnownRate r) =>
KnownStaticTicks (d :/ r) where
staticTicksVal _ =
convertTicks (MkTicks (natVal (Proxy :: Proxy d)) :: Ticks r Integer)
class HasDuration a where
getDuration :: a -> NominalDiffTime
getDuration !x = from nominalDiffTime # (getDurationTicks x :: PicoSeconds)
getDurationTicks
:: (CanBeTicks r i)
=> a -> Ticks r i
getDurationTicks !x = nominalDiffTime # getDuration x
instance HasDuration a =>
HasDuration (Maybe a) where
getDuration Nothing = 0
getDuration (Just !a) = getDuration a
getDurationTicks Nothing = 0
getDurationTicks (Just !a) = getDurationTicks a
class SetTimestamp t (GetTimestamp t) ~ t =>
HasTimestamp t where
type GetTimestamp t
type SetTimestamp t s
timestamp :: Lens t (SetTimestamp t s) (GetTimestamp t) s
timestamp' :: Lens' t (GetTimestamp t)
timestamp' = timestamp
class ( KnownStaticTicks (GetStaticDuration s)
, SetStaticDuration s (GetStaticDuration s) ~ s
) =>
HasStaticDuration (s :: k) where
type SetStaticDuration s (pt :: StaticTicks) :: k
type SetStaticDuration s (pt :: StaticTicks) = s
type GetStaticDuration s :: StaticTicks
instance (KnownRate r, KnownNat t) =>
HasStaticDuration (t :/ r) where
type SetStaticDuration (t :/ r) (t' :/ r') = t' :/ r'
type GetStaticDuration (t :/ r) = t :/ r
toStaticDurationProxy
:: (HasStaticDuration s)
=> proxy s -> Proxy (GetStaticDuration s)
toStaticDurationProxy _ = Proxy
getStaticDuration
:: forall proxy s.
HasStaticDuration s
=> proxy s -> NominalDiffTime
getStaticDuration px =
from nominalDiffTime #
(staticTicksVal (toStaticDurationProxy px) :: PicoSeconds)
getStaticDurationTicks
:: forall proxy s r t i.
( CanBeTicks r i
, KnownNat t
, HasStaticDuration s
, GetStaticDuration s ~ (t :/ r)
)
=> proxy s -> Ticks r i
getStaticDurationTicks px = ticksFromStaticDuration (toStaticDurationProxy px)
ticksFromStaticDuration
:: forall proxy rate ticks i.
(CanBeTicks rate i, KnownNat ticks)
=> proxy (ticks :/ rate) -> Ticks rate i
ticksFromStaticDuration _ =
MkTicks (fromIntegral (natVal (Proxy :: Proxy ticks)))
instance (HasTimestamp a, HasTimestamp b, GetTimestamp a ~ GetTimestamp b) =>
HasTimestamp (Series a b) where
type GetTimestamp (Series a b) = GetTimestamp a
type SetTimestamp (Series a b) t = Series (SetTimestamp a t) (SetTimestamp b t)
timestamp f (Start a) = Start <$> timestamp f a
timestamp f (Next b) = Next <$> timestamp f b