module Synthesizer.Inference.Func.Signal where
import qualified Synthesizer.Physical.Signal as SigP
import qualified Synthesizer.SampleRateContext.Signal as SigC
import Control.Monad.Fix (fix)
import Data.Maybe (catMaybes, isJust)
import Data.List (transpose)
import NumericPrelude.List (shearTranspose)
import PreludeBase as P
newtype T t t' y y' yv =
Cons {eval :: (t',y') -> Evaluated t t' y y' yv}
type Evaluated t t' y y' yv = SigP.T t (Parameter t') y (Parameter y') yv
newtype Parameter a = Parameter {parameterDesc :: [Maybe a]}
liftParam2 ::
([Maybe a] -> [Maybe b] -> [Maybe c]) ->
Parameter a -> Parameter b -> Parameter c
liftParam2 f (Parameter x) (Parameter y) = Parameter (f x y)
cons :: ((t',y') -> SigP.T t (Parameter t') y (Parameter y') yv) -> T t t' y y' yv
cons = Cons
contextFixAmplitude ::
y'
-> Evaluated t t' y y' yv
-> SigC.T y y' yv
contextFixAmplitude amp =
SigC.replaceAmplitude amp . SigP.content
fromContextFreeAmplitude ::
Parameter t'
-> SigC.T y y' yv
-> Evaluated t t' y y' yv
fromContextFreeAmplitude sr (SigC.Cons _amp ss) =
SigP.cons sr anyParameter ss
fromContextCheckAmplitude :: (Eq y') =>
Parameter t'
-> y'
-> SigC.T y y' yv
-> Evaluated t t' y y' yv
fromContextCheckAmplitude sr iamp (SigC.Cons amp ss) =
SigP.cons sr (justParameter amp)
(if iamp==amp then ss else error "fromContextCheckAmplitude: amplitudes differ")
anyParameter :: Parameter q
anyParameter = Parameter []
justParameter :: q -> Parameter q
justParameter x = Parameter [Just x]
inSampleRate :: (t',y') -> t'
inSampleRate = fst
inAmplitude :: (t',y') -> y'
inAmplitude = snd
equalParameter :: Eq q => String -> Maybe q -> Maybe q -> Maybe q
equalParameter name x y =
case (x,y) of
(Nothing,_) -> y
(_,Nothing) -> x
(Just xv, Just yv) ->
if xv == yv
then Just xv
else error ("equalParameter: " ++ name ++ " differ")
equalSampleRate :: Eq t' => Maybe t' -> Maybe t' -> Maybe t'
equalSampleRate = equalParameter "sample rate"
zipJut :: (a -> a -> a) -> [a] -> [a] -> [a]
zipJut f =
let aux (x:xs) (y:ys) = f x y : aux xs ys
aux [] ys = ys
aux xs [] = xs
in aux
mergeParameter :: Parameter q -> Parameter q -> Parameter q
mergeParameter =
liftParam2 (zipJut (\x y -> if isJust x then x else y))
mergeSampleRate ::
Evaluated t t' y0 y0' yv0 -> Evaluated t t' y1 y1' yv1 -> Parameter t'
mergeSampleRate x y =
mergeParameter (SigP.sampleRate x) (SigP.sampleRate y)
mergeParameterEq :: Eq q => String -> Parameter q -> Parameter q -> Parameter q
mergeParameterEq name =
liftParam2 (zipJut (equalParameter name))
mergeSampleRateEq :: Eq t' => Parameter t' -> Parameter t' -> Parameter t'
mergeSampleRateEq = mergeParameterEq "sample rate"
merge :: [a] -> [a] -> [a]
merge (x:xs) ys = x : merge ys xs
merge [] ys = ys
propMerge :: Eq a => [a] -> [a] -> Bool
propMerge xs ys = merge xs ys == concat (transpose [xs,ys])
mergeParameter' :: Parameter t' -> Parameter t' -> Parameter t'
mergeParameter' = liftParam2 merge
checkParameter :: Eq q => String -> q -> Maybe q -> q
checkParameter name x =
maybe x (\y -> if x == y
then x
else error ("checkParameter: deviation from common " ++ name))
checkSampleRate :: Eq t' => t' -> Maybe t' -> t'
checkSampleRate = checkParameter "sample rate"
checkAmplitude :: Eq y' => y' -> Maybe y' -> y'
checkAmplitude = checkParameter "amplitude"
mergeParameters :: [Parameter q] -> Parameter q
mergeParameters =
Parameter . map (head . (++[Nothing]) . filter isJust)
. shearTranspose . map parameterDesc
mergeSampleRates :: [Evaluated t t' y y' yv] -> Parameter t'
mergeSampleRates =
mergeParameters . map SigP.sampleRate
mergeParametersEq :: Eq q => String -> [Parameter q] -> Parameter q
mergeParametersEq name =
Parameter . map (foldl (equalParameter name) Nothing)
. shearTranspose . map parameterDesc
mergeSampleRatesEq :: Eq t' => [Parameter t'] -> Parameter t'
mergeSampleRatesEq = mergeParametersEq "sample rate"
mergeParameters' :: [Parameter q] -> Parameter q
mergeParameters' =
Parameter . concat . shearTranspose . map parameterDesc
guessParameter :: String -> Parameter q -> q
guessParameter context =
head . (++ error (context ++ " undetermined")) . catMaybes . parameterDesc
guessSampleRate :: Evaluated t t' y y' yv -> t'
guessSampleRate = guessParameter "sample rate" . SigP.sampleRate
guessAmplitude :: Evaluated t t' y y' yv -> y'
guessAmplitude = guessParameter "amplitude" . SigP.amplitude
fixSampleRate :: (Eq t') =>
t'
-> T t t' y y' yv
-> T t t' y y' yv
fixSampleRate forcedSampleRate input =
Cons $ \infered ->
let inputSig = eval input infered
in SigP.cons
(justParameter forcedSampleRate)
(SigP.amplitude inputSig)
(if inSampleRate infered == forcedSampleRate
then SigP.samples inputSig
else error "fixSampleRate: sampleRates differ")
loop :: (Eq t') =>
(T t t' y y' yv -> T t t' y y' yv)
-> T t t' y y' yv
loop f =
fix (\x -> f (Cons $ \infered ->
SigP.cons anyParameter anyParameter
(SigP.samples (eval x infered))))