{-# LANGUAGE Rank2Types #-}
module Synthesizer.Dimensional.Process (
T(..),
run, withParam, getSampleRate,
toTimeScalar, toFrequencyScalar,
toTimeDimension, toFrequencyDimension,
intFromTime, intFromTime98,
DimensionGradient, toGradientScalar,
loop, pure,
($:), ($::), ($^), ($#),
(.:), (.^),
liftP, liftP2, liftP3, liftP4,
) where
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import Number.DimensionTerm ((*&), (&/&), )
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import Control.Monad.Fix (MonadFix(mfix), )
import Synthesizer.ApplicativeUtility
import qualified Control.Applicative as App
import Control.Applicative (Applicative)
import NumericPrelude.Numeric
import NumericPrelude.Base
import qualified Prelude as P
import Prelude (RealFrac)
newtype T s u t a = Cons {forall s u t a. T s u t a -> T (Recip u) t -> a
process :: DN.T (Dim.Recip u) t -> a}
instance Functor (T s u t) where
fmap :: forall a b. (a -> b) -> T s u t a -> T s u t b
fmap a -> b
f (Cons T (Recip u) t -> a
g) = forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Recip u) t -> a
g)
instance Applicative (T s u t) where
pure :: forall a. a -> T s u t a
pure = forall a s u t. a -> T s u t a
pure
<*> :: forall a b. T s u t (a -> b) -> T s u t a -> T s u t b
(<*>) = forall s u t a b. T s u t (a -> b) -> T s u t a -> T s u t b
apply
instance Monad (T s u t) where
return :: forall a. a -> T s u t a
return = forall a s u t. a -> T s u t a
pure
>>= :: forall a b. T s u t a -> (a -> T s u t b) -> T s u t b
(>>=) = forall s u t a b. T s u t a -> (a -> T s u t b) -> T s u t b
bind
instance MonadFix (T s u t) where
mfix :: forall a. (a -> T s u t a) -> T s u t a
mfix = forall (f :: * -> *) a. Functor f => f (a -> a) -> f a
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
withParam
{-# INLINE pure #-}
pure :: a -> T s u t a
pure :: forall a s u t. a -> T s u t a
pure = forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
{-# INLINE apply #-}
apply :: T s u t (a -> b) -> T s u t a -> T s u t b
apply :: forall s u t a b. T s u t (a -> b) -> T s u t a -> T s u t b
apply (Cons T (Recip u) t -> a -> b
f) T s u t a
arg = forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons forall a b. (a -> b) -> a -> b
$ \T (Recip u) t
sr -> T (Recip u) t -> a -> b
f T (Recip u) t
sr (forall s u t a. T s u t a -> T (Recip u) t -> a
process T s u t a
arg T (Recip u) t
sr)
{-# INLINE run #-}
run :: (Dim.C u) => DN.T (Dim.Recip u) t -> (forall s. T s u t a) -> a
run :: forall u t a. C u => T (Recip u) t -> (forall s. T s u t a) -> a
run T (Recip u) t
sampleRate forall s. T s u t a
f = forall s u t a. T s u t a -> T (Recip u) t -> a
process forall s. T s u t a
f T (Recip u) t
sampleRate
{-# INLINE bind #-}
bind :: T s u t a -> (a -> T s u t b) -> T s u t b
bind :: forall s u t a b. T s u t a -> (a -> T s u t b) -> T s u t b
bind (Cons T (Recip u) t -> a
f) a -> T s u t b
mg =
forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons forall a b. (a -> b) -> a -> b
$ \ T (Recip u) t
sr -> forall s u t a. T s u t a -> T (Recip u) t -> a
process (a -> T s u t b
mg (T (Recip u) t -> a
f T (Recip u) t
sr)) T (Recip u) t
sr
{-# INLINE withParam #-}
withParam :: (a -> T s u t b) -> T s u t (a -> b)
withParam :: forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
withParam a -> T s u t b
f = forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons (\T (Recip u) t
sr a
a -> forall s u t a. T s u t a -> T (Recip u) t -> a
process (a -> T s u t b
f a
a) T (Recip u) t
sr)
{-# INLINE getSampleRate #-}
getSampleRate :: Dim.C u => T s u t (DN.T (Dim.Recip u) t)
getSampleRate :: forall u s t. C u => T s u t (T (Recip u) t)
getSampleRate = forall s u t a. (T (Recip u) t -> a) -> T s u t a
Cons forall a. a -> a
id
{-# INLINE toTimeScalar #-}
toTimeScalar :: (Ring.C t, Dim.C u) =>
DN.T u t -> T s u t t
toTimeScalar :: forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u t
time =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall u a. (C u, C a) => T u a -> T (Recip u) a -> a
DN.mulToScalar T u t
time) forall u s t. C u => T s u t (T (Recip u) t)
getSampleRate
{-# INLINE toFrequencyScalar #-}
toFrequencyScalar :: (Field.C t, Dim.C u) =>
DN.T (Dim.Recip u) t -> T s u t t
toFrequencyScalar :: forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar T (Recip u) t
freq =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T (Recip u) t
freq) forall u s t. C u => T s u t (T (Recip u) t)
getSampleRate
{-# INLINE toTimeDimension #-}
toTimeDimension :: (Field.C t, Dim.C u) =>
t -> T s u t (DN.T u t)
toTimeDimension :: forall t u s. (C t, C u) => t -> T s u t (T u t)
toTimeDimension t
t =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\T (Recip u) t
sampleRate -> t
t forall u a. (C u, C a) => a -> T u a -> T u a
*& forall u a. (C u, C a) => T (Recip u) a -> T u a
DN.unrecip T (Recip u) t
sampleRate) forall u s t. C u => T s u t (T (Recip u) t)
getSampleRate
{-# INLINE toFrequencyDimension #-}
toFrequencyDimension :: (Ring.C t, Dim.C u) =>
t -> T s u t (DN.T (Dim.Recip u) t)
toFrequencyDimension :: forall t u s. (C t, C u) => t -> T s u t (T (Recip u) t)
toFrequencyDimension t
f =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\T (Recip u) t
sampleRate -> t
f forall u a. (C u, C a) => a -> T u a -> T u a
*& T (Recip u) t
sampleRate) forall u s t. C u => T s u t (T (Recip u) t)
getSampleRate
type DimensionGradient u v = Dim.Mul (Dim.Recip u) v
{-# INLINE toGradientScalar #-}
toGradientScalar :: (Field.C q, Dim.C u, Dim.C v) =>
DN.T v q -> DN.T (DimensionGradient u v) q -> T s u q q
toGradientScalar :: forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amp T (Mul (Recip u) v) q
steepness =
forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar
(forall u v a. (C u, C v) => (u -> v) -> T u a -> T v a
DN.rewriteDimension (forall u. C u => Mul u Scalar -> u
Dim.identityRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u0 u1 v.
(C u0, C u1, C v) =>
(u0 -> u1) -> Mul v u0 -> Mul v u1
Dim.applyRightMul forall u. C u => Mul u (Recip u) -> Scalar
Dim.cancelRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u0 u1 u2.
(C u0, C u1, C u2) =>
Mul (Mul u0 u1) u2 -> Mul u0 (Mul u1 u2)
Dim.associateRight) forall a b. (a -> b) -> a -> b
$
T (Mul (Recip u) v) q
steepness forall u v a.
(C u, C v, C a) =>
T u a -> T v a -> T (Mul u (Recip v)) a
&/& T v q
amp)
checkedChunkSize ::
String -> Int -> Int
checkedChunkSize :: String -> Int -> Int
checkedChunkSize String
funcName Int
cs =
if Int
csforall a. Ord a => a -> a -> Bool
>Int
0
then Int
cs
else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
funcName forall a. [a] -> [a] -> [a]
++ String
": negative chunkSize"
intFromTime ::
(RealRing.C t, Dim.C u) =>
String ->
DN.T u t ->
T s u t Int
intFromTime :: forall t u s. (C t, C u) => String -> T u t -> T s u t Int
intFromTime String
funcName T u t
t =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> Int
checkedChunkSize String
funcName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (C a, C b) => a -> b
RealRing.ceiling) forall a b. (a -> b) -> a -> b
$ forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u t
t
intFromTime98 ::
(Ring.C t, RealFrac t, Dim.C u) =>
String ->
DN.T u t ->
T s u t Int
intFromTime98 :: forall t u s.
(C t, RealFrac t, C u) =>
String -> T u t -> T s u t Int
intFromTime98 String
funcName T u t
t =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> Int
checkedChunkSize String
funcName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling) forall a b. (a -> b) -> a -> b
$ forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u t
t