```{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Synthesizer.Filter.Composition where

import qualified Synthesizer.Filter.Basic as FilterBasic
import Synthesizer.Filter.Basic (Filter, apply, )

import qualified Algebra.Module         as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField      as RealField
import qualified Algebra.Field          as Field
import qualified Number.Complex         as Complex

import PreludeBase
import NumericPrelude

{- todo:
- functions that build a FilterComposition for specific filters
(1st order, universal, allpass, butterworth, chebyshev)
- functions that turn physical filter parameters into
internal ones
- How can these function be combined?
A function like
[ FilterComposition v [m] ] -> FilterComposition v [[m]]
is not satisfying, since the conversion function cannot rely
that the structure of all FilterComposition v [m] is equal.
If the list is empty the structure can't even be reconstructed.
-}

{-|
This describes a generic filter with one input and one main output
that consists of non-recursive and recursive parts.
If you use Feedback, make sure that at least
one of the filters of a circle includes a delay,
otherwise the recursion will fail.
The main output is used to glue different parts together.
Additionally the functions 'apply' and 'transferFunction'
provide the signals at every node of the network.
-}
data T filter t a v =
Prim (filter t a v)
{-^ a filter primitve -}
| Serial   [T filter t a v]
{-^ serial chain of filters -}
| Parallel [T filter t a v]
{-^ filters working parallel, there output is mixed together -}
| Feedback (T filter t a v) (T filter t a v)
{-^ filter the signal in the forward direction and
feed back the output signal filtered by the second filter -}

{-|
This is the data structure is used for the results
of 'apply' and 'transferFunction'.
Each constructor corresponds to one of 'Filter.Composition.T'.
By choosing only some of the outputs
the lazy evaluation will content
with applying the necessary filter steps, only.
-}
data Sockets s = Sockets {output :: s, socket :: SocketSpec s}

data SocketSpec s =
Output
| Multiplier [Sockets s]
| Loop (Sockets s) (Sockets s)

instance (Filter list filter) =>
Filter (list) (T filter) where
{-
apply :: (Module.C a v) =>
FilterComposition a v -> TwoWayList v -> TwoWayList v
-}
apply f x = output (applyMulti f x)
{-
transferFunction :: (Trans.C b, Module.C a (Complex.T b)) =>
T filter a v -> b -> (Complex.T b)
-}
transferFunction f w = output (transferFunctionMulti f w)

{-| Apply a filter network to a signal and keep the output of all nodes.
Generic function that is wrapped by 'apply'. -}
applyMulti :: (RealField.C t, Trans.C t,
Module.C a v, Module.C a (list v), Filter list filter) =>
T filter t a v -> list v -> Sockets (list v)
applyMulti (Prim f) x =
Sockets (apply f x) Output
applyMulti (Serial fs) x =
let sq = scanl (\(Sockets y _) -> flip applyMulti y) (Sockets x Output) fs
in  Sockets (output (last sq)) (Multiplier (tail sq))
applyMulti (Parallel fs) x =
let socks = map (flip applyMulti x) fs
y = foldr (Additive.+) zero (map output socks)
{- the distinction between 'feed' and 'back'
can be dropped in a more general net structure -}
applyMulti (Feedback feed back) x =
let sockY@(Sockets y _) = applyMulti feed ((Additive.+) x z)
sockZ@(Sockets z _) = applyMulti back y
in  Sockets y (Loop sockY sockZ)

transferFunctionMulti ::
(Trans.C t, Module.C a t, Filter list filter) =>
T filter t a v -> t -> Sockets (Complex.T t)
transferFunctionMulti f w = tfAbsolutize 1 (tfRelative w f)

{-| Compute the transitivity for each part of the filter network.
We must do this in such a relative manner to be able
to compute feedback. -}
tfRelative ::
(Trans.C t, Module.C a t, Filter list filter) =>
t -> T filter t a v -> Sockets (Complex.T t)
tfRelative w (Prim f) =
Sockets (FilterBasic.transferFunction f w) Output
tfRelative w (Serial fs) =
let sq = map (tfRelative w) fs
in  Sockets (product (map output sq)) (Multiplier sq)
tfRelative w (Parallel fs) =
let sq = map (tfRelative w) fs
in  Sockets (sum (map output sq)) (Adder sq)
tfRelative w (Feedback feed back) =
let sockY = tfRelative w feed
sockZ = tfRelative w back
q = output sockY / (1 - output sockZ)
in  Sockets q (Loop sockY sockZ)

{-| Make the results from 'tfRelative' absolute. -}
tfAbsolutize :: (Field.C a) => a -> Sockets a -> Sockets a
tfAbsolutize x (Sockets y spec) = Sockets (x*y)
(case spec of
(Multiplier socks) ->
let sq = scanl (\(Sockets z _) -> tfAbsolutize z)
(Sockets x Output) socks
in  Multiplier (tail sq)