{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{- |
This is like "Synthesizer.LLVM.Causal.Controlled"
but for vectorised signals.
-}
module Synthesizer.LLVM.Causal.ControlledPacked (C(..)) where

import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
import qualified Synthesizer.LLVM.Filter.SecondOrderCascade as Cascade
import qualified Synthesizer.LLVM.Filter.Moog as Moog
import qualified Synthesizer.LLVM.Filter.Universal as UniFilter

import qualified Synthesizer.LLVM.Causal.ProcessPacked as CausalS
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial

import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Util.Loop (Phi, )
import LLVM.Core (IsSized, )

import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal.Number ((:*:), )

import Control.Arrow ((<<<), arr, first, )


{- |
A filter parameter type uniquely selects a filter function.
However it does not uniquely determine the input and output type,
since the same filter can run on mono and stereo signals.
-}
class (a ~ Input parameter b, b ~ Output parameter a) => C parameter a b where
   type Input  parameter b :: *
   type Output parameter a :: *
   process :: (Causal.C process) => process (parameter, a) b


{-
Instances for the particular filters shall be defined here
in order to avoid orphan instances.
-}

instance
   (Serial.C v, Serial.Element v ~ a,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
    A.PseudoRing v) =>
      C (Filt1.Parameter a) v (Filt1.Result v) where
   type Input  (Filt1.Parameter a) (Filt1.Result v) = v
   type Output (Filt1.Parameter a) v = Filt1.Result v
   process = Filt1.causalPacked

instance
   (Serial.C v, Serial.Element v ~ a,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
    A.PseudoRing v, A.IntegerConstant v, Memory.C v) =>
      C (Filt2.Parameter a) v v where
   type Input  (Filt2.Parameter a) v = v
   type Output (Filt2.Parameter a) v = v
   process = Filt2.causalPacked

instance
   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
    Serial.C v, Serial.Element v ~ LLVM.Value a,
    SoV.IntegerConstant a,
    A.PseudoRing v, A.IntegerConstant v, Memory.C v,
    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
    LLVM.IsPrimitive a,
    LLVM.IsPrimitive am,
    TypeNum.Positive (n :*: LLVM.UnknownSize),
    TypeNum.Natural n) =>
      C (Cascade.ParameterValue n a) v v where
   type Input  (Cascade.ParameterValue n a) v = v
   type Output (Cascade.ParameterValue n a) v = v
   process = Cascade.causalPacked


instance
   (Serial.C v, Serial.Element v ~ a,
    Memory.C a, A.IntegerConstant a,
    A.PseudoRing v, A.PseudoRing a) =>
      C (Allpass.Parameter a) v v where
   type Input  (Allpass.Parameter a) v = v
   type Output (Allpass.Parameter a) v = v
   process = Allpass.causalPacked

instance
   (TypeNum.Natural n,
    Serial.C v, Serial.Element v ~ a,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
    A.PseudoRing v, A.RationalConstant v) =>
      C (Allpass.CascadeParameter n a) v v where
   type Input  (Allpass.CascadeParameter n a) v = v
   type Output (Allpass.CascadeParameter n a) v = v
   process = Allpass.cascadePacked


instance
   (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,
    a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b,
    TypeNum.Natural n) =>
      C (Moog.Parameter n a) v v where
   type Input  (Moog.Parameter n a) v = v
   type Output (Moog.Parameter n a) v = v
   process =
      CausalS.pack Moog.causal <<<
      first (arr Serial.constant)


instance
   (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,
    a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b) =>
      C (UniFilter.Parameter a) v (UniFilter.Result v) where
   type Input  (UniFilter.Parameter a) (UniFilter.Result v) = v
   type Output (UniFilter.Parameter a) v = UniFilter.Result v
   process =
      CausalS.pack UniFilter.causal <<<
      first (arr Serial.constant)