{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Signals equipped with volume and sample rate information that may carry a unit.
Kind of volume and sample rate is configurable by types.
-}
module Synthesizer.Dimensional.Signal.Private where

import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process (($#), )

import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
import qualified Synthesizer.Generic.Signal as SigG

-- import qualified Data.StorableVector.Lazy.Pattern as SVP
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Frame.Stereo as Stereo
import qualified Synthesizer.Basic.Binary as BinSmp
import Data.Int (Int16, )
import Foreign.Storable (Storable, )

import qualified Synthesizer.State.Signal as Sig

import qualified Algebra.Module         as Module
import qualified Algebra.RealRing      as RealRing
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim


-- import NumericPrelude.Numeric
import NumericPrelude.Base as P
import Prelude ()


{- |
A signal value 0.5 at global amplitude 1
and signal value 1 at global amplitude 0.5
shall represent the same signal.
Thus observing the amplitude breaks the abstraction.

Cyclic nature such as needed for Fourier transform
must be expressend in the body.
It would be nice to use the data type for waveforms, too,
but for waveforms the @rate@ parameter makes no sense.
-}
data T rate amplitude body =
   Cons {
      forall rate amplitude body. T rate amplitude body -> rate
sampleRate :: rate,
      forall rate amplitude body. T rate amplitude body -> amplitude
amplitude :: amplitude,
      forall rate amplitude body. T rate amplitude body -> body
body :: body
   }

type R s v y yv = T (Rate.Phantom s) (Amp.Dimensional v y) (Sig.T yv)


{-# INLINE actualSampleRate #-}
actualSampleRate ::
   T (Rate.Actual rate) amp sig -> rate
actualSampleRate :: forall rate amp sig. T (Actual rate) amp sig -> rate
actualSampleRate T (Actual rate) amp sig
sig =
   let (Rate.Actual rate
amp) = forall rate amplitude body. T rate amplitude body -> rate
sampleRate T (Actual rate) amp sig
sig
   in  rate
amp

{-# INLINE actualAmplitude #-}
actualAmplitude ::
   T rate (Amp.Numeric amp) sig -> amp
actualAmplitude :: forall rate amp sig. T rate (Numeric amp) sig -> amp
actualAmplitude T rate (Numeric amp) sig
sig =
   let (Amp.Numeric amp
amp) = forall rate amplitude body. T rate amplitude body -> amplitude
amplitude T rate (Numeric amp) sig
sig
   in  amp
amp


{-# INLINE toAmplitudeScalar #-}
toAmplitudeScalar :: (Field.C y, Dim.C v) =>
   T rate (Amp.Dimensional v y) sig -> DN.T v y -> y
toAmplitudeScalar :: forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T rate (Dimensional v y) sig
sig T v y
y =
   forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
y (forall rate amp sig. T rate (Numeric amp) sig -> amp
actualAmplitude T rate (Dimensional v y) sig
sig)

{-# INLINE rewriteAmplitudeDimension #-}
rewriteAmplitudeDimension :: (Dim.C v0, Dim.C v1) =>
   (v0 -> v1) ->
   T rate (Amp.Dimensional v0 y) sig ->
   T rate (Amp.Dimensional v1 y) sig
rewriteAmplitudeDimension :: forall v0 v1 rate y sig.
(C v0, C v1) =>
(v0 -> v1)
-> T rate (Dimensional v0 y) sig -> T rate (Dimensional v1 y) sig
rewriteAmplitudeDimension v0 -> v1
f (Cons rate
rate (Amp.Numeric T v0 y
amp) sig
ss) =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons rate
rate (forall amp. amp -> Numeric amp
Amp.Numeric forall a b. (a -> b) -> a -> b
$ forall u v a. (C u, C v) => (u -> v) -> T u a -> T v a
DN.rewriteDimension v0 -> v1
f T v0 y
amp) sig
ss

{-# INLINE asTypeOfAmplitude #-}
asTypeOfAmplitude :: y -> T rate (Amp.Dimensional v y) sig -> y
asTypeOfAmplitude :: forall y rate v sig. y -> T rate (Dimensional v y) sig -> y
asTypeOfAmplitude = forall a b. a -> b -> a
const



{-# INLINE scalarSamples #-}
scalarSamples ::
   (Ring.C y, SigG.Transform sig y) =>
   (amp -> y) -> T rate (Amp.Numeric amp) (sig y) -> sig y
scalarSamples :: forall y (sig :: * -> *) amp rate.
(C y, Transform sig y) =>
(amp -> y) -> T rate (Numeric amp) (sig y) -> sig y
scalarSamples amp -> y
toAmpScalar T rate (Numeric amp) (sig y)
sig =
   let y :: y
y = amp -> y
toAmpScalar (forall rate amp sig. T rate (Numeric amp) sig -> amp
actualAmplitude T rate (Numeric amp) (sig y)
sig)
   in  forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> sig a -> sig a
FiltG.amplify y
y (forall rate amplitude body. T rate amplitude body -> body
body T rate (Numeric amp) (sig y)
sig)

{-# INLINE vectorSamples #-}
vectorSamples ::
   (Module.C y yv, SigG.Transform sig yv) =>
   (amp -> y) -> T rate (Amp.Numeric amp) (sig yv) -> sig yv
vectorSamples :: forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
vectorSamples amp -> y
toAmpScalar T rate (Numeric amp) (sig yv)
sig =
   let y :: y
y = amp -> y
toAmpScalar (forall rate amp sig. T rate (Numeric amp) sig -> amp
actualAmplitude T rate (Numeric amp) (sig yv)
sig)
   in  forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
FiltG.amplifyVector y
y (forall rate amplitude body. T rate amplitude body -> body
body T rate (Numeric amp) (sig yv)
sig)


{-# INLINE embedSampleRate #-}
embedSampleRate :: (Dim.C u) =>
   Proc.T s u t
      (T (Rate.Phantom s) amp sig ->
       T (Rate.Dimensional u t) amp sig)
embedSampleRate :: forall u s t amp sig.
C u =>
T s u t (T (Phantom s) amp sig -> T (Dimensional u t) amp sig)
embedSampleRate =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\T (Recip u) t
rate (Cons Phantom s
_ amp
amp sig
sig) -> forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons (forall rate. rate -> Actual rate
Rate.Actual T (Recip u) t
rate) amp
amp sig
sig)
      forall u s t. C u => T s u t (T (Recip u) t)
Proc.getSampleRate

{-# INLINE render #-}
render :: (Dim.C u) =>
   DN.T (Dim.Recip u) t ->
   (forall s. Proc.T s u t (T (Rate.Phantom s) amp sig)) ->
   T (Rate.Dimensional u t) amp sig
render :: forall u t amp sig.
C u =>
T (Recip u) t
-> (forall s. T s u t (T (Phantom s) amp sig))
-> T (Dimensional u t) amp sig
render T (Recip u) t
rate forall s. T s u t (T (Phantom s) amp sig)
signal =
   forall u t a. C u => T (Recip u) t -> (forall s. T s u t a) -> a
Proc.run T (Recip u) t
rate (forall u s t amp sig.
C u =>
T s u t (T (Phantom s) amp sig -> T (Dimensional u t) amp sig)
embedSampleRate forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Proc.$: forall s. T s u t (T (Phantom s) amp sig)
signal)

{-# INLINE apply #-}
apply :: (Dim.C u) =>
   (forall s. Proc.T s u t (T (Rate.Phantom s) amp0 sig0 -> T (Rate.Phantom s) amp1 sig1)) ->
   T (Rate.Dimensional u t) amp0 sig0 -> T (Rate.Dimensional u t) amp1 sig1
apply :: forall u t amp0 sig0 amp1 sig1.
C u =>
(forall s.
 T s u t (T (Phantom s) amp0 sig0 -> T (Phantom s) amp1 sig1))
-> T (Dimensional u t) amp0 sig0 -> T (Dimensional u t) amp1 sig1
apply forall s.
T s u t (T (Phantom s) amp0 sig0 -> T (Phantom s) amp1 sig1)
p T (Dimensional u t) amp0 sig0
x =
   forall u t amp sig.
C u =>
T (Recip u) t
-> (forall s. T s u t (T (Phantom s) amp sig))
-> T (Dimensional u t) amp sig
render
      (forall rate amp sig. T (Actual rate) amp sig -> rate
actualSampleRate T (Dimensional u t) amp0 sig0
x)
      (forall s.
T s u t (T (Phantom s) amp0 sig0 -> T (Phantom s) amp1 sig1)
p forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
$# forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons forall s. Phantom s
Rate.Phantom (forall rate amplitude body. T rate amplitude body -> amplitude
amplitude T (Dimensional u t) amp0 sig0
x) (forall rate amplitude body. T rate amplitude body -> body
body T (Dimensional u t) amp0 sig0
x))


{-
Zip heterogenous signals.
This yields a signal with mixed amplitudes,
e.g. @T rate (amp0, amp1) (Sig.T (y0,y1))@
and is consistent with the way
@Causal@ and @Wave.Controlled@ handle multiple sources.
However, it may be dangerous, since @T rate amp (Sig.T (y0,y1))@
might be used for stereo signals.
Of course, for stereo signals @Stereo.T@ should be prefered.
-}
zip ::
   (SigG.Transform sig y1, SigG.Transform sig (y0,y1), SigG.Read sig y0) =>
   T (Rate.Phantom s) amp0 (sig y0) ->
   T (Rate.Phantom s) amp1 (sig y1) ->
   T (Rate.Phantom s) (amp0,amp1) (sig (y0,y1))
zip :: forall (sig :: * -> *) y1 y0 s amp0 amp1.
(Transform sig y1, Transform sig (y0, y1), Read sig y0) =>
T (Phantom s) amp0 (sig y0)
-> T (Phantom s) amp1 (sig y1)
-> T (Phantom s) (amp0, amp1) (sig (y0, y1))
zip T (Phantom s) amp0 (sig y0)
x T (Phantom s) amp1 (sig y1)
y =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons
      forall s. Phantom s
Rate.Phantom
      (forall rate amplitude body. T rate amplitude body -> amplitude
amplitude T (Phantom s) amp0 (sig y0)
x, forall rate amplitude body. T rate amplitude body -> amplitude
amplitude T (Phantom s) amp1 (sig y1)
y)
      (forall (sig :: * -> *) a b.
(Read sig a, Transform sig b, Transform sig (a, b)) =>
sig a -> sig b -> sig (a, b)
SigG.zip (forall rate amplitude body. T rate amplitude body -> body
body T (Phantom s) amp0 (sig y0)
x) (forall rate amplitude body. T rate amplitude body -> body
body T (Phantom s) amp1 (sig y1)
y))


{-# INLINE processBody #-}
processBody ::
   (sig0 -> sig1) ->
   T rate amp sig0 ->
   T rate amp sig1
processBody :: forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
processBody sig0 -> sig1
f (Cons rate
rate amp
amp sig0
sig) =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons rate
rate amp
amp (sig0 -> sig1
f sig0
sig)

{-# INLINE replaceBody #-}
replaceBody ::
   sig1 ->
   T rate amp sig0 ->
   T rate amp sig1
replaceBody :: forall sig1 rate amp sig0.
sig1 -> T rate amp sig0 -> T rate amp sig1
replaceBody sig1
sig =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
processBody (forall a b. a -> b -> a
const sig1
sig)

{-# INLINE fromBody #-}
fromBody ::
   amp -> sig -> T (Rate.Phantom s) (Amp.Numeric amp) sig
fromBody :: forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
fromBody amp
amp =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons forall s. Phantom s
Rate.Phantom (forall amp. amp -> Numeric amp
Amp.Numeric amp
amp)

{-# INLINE flatFromBody #-}
flatFromBody ::
   sig -> T (Rate.Phantom s) (Amp.Flat y) sig
flatFromBody :: forall sig s y. sig -> T (Phantom s) (Flat y) sig
flatFromBody =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons forall s. Phantom s
Rate.Phantom forall y. Flat y
Amp.Flat

{-# INLINE abstractFromBody #-}
abstractFromBody ::
   sig -> T (Rate.Phantom s) Amp.Abstract sig
abstractFromBody :: forall sig s. sig -> T (Phantom s) Abstract sig
abstractFromBody =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons forall s. Phantom s
Rate.Phantom Abstract
Amp.Abstract

{-# INLINE primitiveFromBody #-}
primitiveFromBody ::
   (Amp.Primitive amp) =>
   sig -> T (Rate.Phantom s) amp sig
primitiveFromBody :: forall amp sig s. Primitive amp => sig -> T (Phantom s) amp sig
primitiveFromBody =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
Cons forall s. Phantom s
Rate.Phantom forall amp. Primitive amp => amp
Amp.primitive


-- * caching

{-# INLINE cache #-}
cache ::
   (Storable yv) =>
   T rate amp (Sig.T yv) ->
   T rate amp (Sig.T yv)
cache :: forall yv rate amp.
Storable yv =>
T rate amp (T yv) -> T rate amp (T yv)
cache =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
processBody
      (forall a. Storable a => T a -> T a
Sig.fromStorableSignal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => ChunkSize -> T a -> T a
Sig.toStorableSignal ChunkSize
defaultChunkSize)

{-# INLINE bindCached #-}
bindCached ::
   (Storable yv) =>
   Proc.T s u t (T rate amp (Sig.T yv)) ->
   (T rate amp (Sig.T yv) -> Proc.T s u t b) ->
   Proc.T s u t b
bindCached :: forall yv s u t rate amp b.
Storable yv =>
T s u t (T rate amp (T yv))
-> (T rate amp (T yv) -> T s u t b) -> T s u t b
bindCached T s u t (T rate amp (T yv))
x T rate amp (T yv) -> T s u t b
y =
   T rate amp (T yv) -> T s u t b
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall yv rate amp.
Storable yv =>
T rate amp (T yv) -> T rate amp (T yv)
cache forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T s u t (T rate amp (T yv))
x

{-# INLINE share #-}
share ::
   (Storable yv) =>
   Proc.T s u t (T rate amp (Sig.T yv)) ->
   (Proc.T s u t (T rate amp (Sig.T yv)) -> Proc.T s u t b) ->
   Proc.T s u t b
share :: forall yv s u t rate amp b.
Storable yv =>
T s u t (T rate amp (T yv))
-> (T s u t (T rate amp (T yv)) -> T s u t b) -> T s u t b
share T s u t (T rate amp (T yv))
x T s u t (T rate amp (T yv)) -> T s u t b
y = forall yv s u t rate amp b.
Storable yv =>
T s u t (T rate amp (T yv))
-> (T rate amp (T yv) -> T s u t b) -> T s u t b
bindCached T s u t (T rate amp (T yv))
x (T s u t (T rate amp (T yv)) -> T s u t b
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return)



{-# INLINE store #-}
store ::
   (RealRing.C t, Dim.C u, Storable yv) =>
   DN.T u t ->
   Proc.T s u t (
      {-
      Rate.Phantom required,
      because chunk size is dicretized with respect to the process' sample rate
      -}
      T (Rate.Phantom s) amp (Sig.T yv) ->
      T (Rate.Phantom s) amp (SigSt.T yv))
store :: forall t u yv s amp.
(C t, C u, Storable yv) =>
T u t
-> T s u t (T (Phantom s) amp (T yv) -> T (Phantom s) amp (T yv))
store T u t
chunkSize =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\Int
cs -> forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
processBody (forall a. Storable a => ChunkSize -> T a -> T a
Sig.toStorableSignal (Int -> ChunkSize
SigSt.chunkSize Int
cs)))
      (forall t u s. (C t, C u) => String -> T u t -> T s u t Int
Proc.intFromTime String
"Dimensional.Signal.store" T u t
chunkSize)

{-
better use ChunkySize.Signal.store
we do not need Proc context
{-# INLINE storeTake #-}
storeTake ::
   (RealRing.C t, Dim.C u, Storable yv) =>
   Proc.T s u t (
      T (Rate.Phantom s) Amp.Abstract SVP.LazySize ->
      T (Rate.Phantom s) amp (Sig.T yv) ->
      T (Rate.Phantom s) amp (SigSt.T yv))
storeTake =
   return
      (\cs -> processBody (Sig.toStorableSignalVary (body cs)))
-}

{-# INLINE restore #-}
restore ::
   (SigG.Read sig yv) =>
   T rate amp (sig yv) ->
   T rate amp (Sig.T yv)
restore :: forall (sig :: * -> *) yv rate amp.
Read sig yv =>
T rate amp (sig yv) -> T rate amp (T yv)
restore =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
processBody forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState

{-
{-# INLINE restore #-}
restore ::
   (Storable yv) =>
   T rate amp (SigSt.T yv) ->
   T rate amp (Sig.T yv)
restore =
   processBody Sig.fromStorableSignal
-}



{-# INLINE toStorableInt16Mono #-}
toStorableInt16Mono ::
   (RealRing.C a) =>
   T rate (Amp.Dimensional Dim.Voltage a) (Sig.T a) ->
   SigSt.T Int16
toStorableInt16Mono :: forall a rate.
C a =>
T rate (Dimensional Voltage a) (T a) -> T Int16
toStorableInt16Mono =
   forall a. Storable a => ChunkSize -> T a -> T a
Sig.toStorableSignal ChunkSize
defaultChunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> Int16
BinSmp.int16FromCanonical forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall y (sig :: * -> *) amp rate.
(C y, Transform sig y) =>
(amp -> y) -> T rate (Numeric amp) (sig y) -> sig y
scalarSamples (forall u a. C u => u -> T u a -> a
DN.toNumberWithDimension Voltage
Dim.voltage)

{-# INLINE toStorableInt16Stereo #-}
toStorableInt16Stereo ::
   (Module.C a a, RealRing.C a) =>
   T rate (Amp.Dimensional Dim.Voltage a) (Sig.T (Stereo.T a)) ->
   SigSt.T (Stereo.T Int16)
toStorableInt16Stereo :: forall a rate.
(C a a, C a) =>
T rate (Dimensional Voltage a) (T (T a)) -> T (T Int16)
toStorableInt16Stereo =
   forall a. Storable a => ChunkSize -> T a -> T a
Sig.toStorableSignal ChunkSize
defaultChunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> T a -> T b
Sig.map (forall a b. (a -> b) -> T a -> T b
Stereo.map forall a. C a => a -> Int16
BinSmp.int16FromCanonical) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
vectorSamples (forall u a. C u => u -> T u a -> a
DN.toNumberWithDimension Voltage
Dim.voltage)


defaultChunkSize :: SigSt.ChunkSize
defaultChunkSize :: ChunkSize
defaultChunkSize =
--   SigSt.chunkSize 131072
   ChunkSize
SigSt.defaultChunkSize