-- |
-- Module      :  DobutokO.Sound.Effects.Classes.ThdParamSet
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the SoX effects. 
-- 

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

module DobutokO.Sound.Effects.Classes.ThdParamSet where

-- inspired with: https://wiki.haskell.org/Scoped_type_variables
import GHC.Base (asTypeOf)
import DobutokO.Sound.Effects.Bend
import DobutokO.Sound.Effects.Biquad
import DobutokO.Sound.Effects.Chorus
import DobutokO.Sound.Effects.Dither
import DobutokO.Sound.Effects.Echo
import DobutokO.Sound.Effects.Fade
import DobutokO.Sound.Effects.Gain
import DobutokO.Sound.Effects.LADSPA
import DobutokO.Sound.Effects.MCompand
import DobutokO.Sound.Effects.Phaser
import DobutokO.Sound.Effects.Pitch
import DobutokO.Sound.Effects.Rate
import DobutokO.Sound.Effects.Reverb
import DobutokO.Sound.Effects.Silence
import DobutokO.Sound.Effects.Sinc
import DobutokO.Sound.Effects.Spectrogram
import DobutokO.Sound.Effects.Stretch
import DobutokO.Sound.Effects.Tempo
import DobutokO.Sound.Effects.Vol
import DobutokO.Sound.One

class ThdParamSet3 a b where
  set33 :: a -> b -> b
    
class ThdParamSetL3 a b where
  set33L :: [a] -> b -> b

class ThdParamSet3O a b where
  set33o :: (One2 a) -> b -> b

instance ThdParamSet3 a (BendTrio a b) where
  set33 :: a -> BendTrio a b -> BendTrio a b
set33 = a -> BendTrio a b -> BendTrio a b
forall a b. a -> BendTrio a b -> BendTrio a b
bendTrioSet3

instance ThdParamSet3 c (Bend a b c) where
  set33 :: c -> Bend a b c -> Bend a b c
set33 = c -> Bend a b c -> Bend a b c
forall c a b. c -> Bend a b c -> Bend a b c
bendSet3

instance ThdParamSet3 a (Coeffs a)  where
  set33 :: a -> Coeffs a -> Coeffs a
set33 = a -> Coeffs a -> Coeffs a
forall a. a -> Coeffs a -> Coeffs a
coeffsSet3 

instance ThdParamSet3 a (ChorusTail a b)  where
  set33 :: a -> ChorusTail a b -> ChorusTail a b
set33 = Int -> a -> ChorusTail a b -> ChorusTail a b
forall a b. Int -> a -> ChorusTail a b -> ChorusTail a b
chorusTailSet1 Int
3

instance ThdParamSetL3 b (Chorus a b)  where
  set33L :: [b] -> Chorus a b -> Chorus a b
set33L = [b] -> Chorus a b -> Chorus a b
forall b a. [b] -> Chorus a b -> Chorus a b
chorusSet2  

instance ThdParamSet3 c (Dither a b c) where 
  set33 :: c -> Dither a b c -> Dither a b c
set33 = c -> Dither a b c -> Dither a b c
forall c a b. c -> Dither a b c -> Dither a b c
ditherSet3

instance ThdParamSetL3 b (Echo a b)  where
  set33L :: [b] -> Echo a b -> Echo a b
set33L = [b] -> Echo a b -> Echo a b
forall b a. [b] -> Echo a b -> Echo a b
echoSet2

instance ThdParamSetL3 b (Echos a b)  where
  set33L :: [b] -> Echos a b -> Echos a b
set33L = [b] -> Echos a b -> Echos a b
forall b a. [b] -> Echos a b -> Echos a b
echosSet2

instance ThdParamSet3 String Fade where
  set33 :: String -> Fade -> Fade
set33 = Int -> String -> Fade -> Fade
fadeSet2E Int
3

instance ThdParamSet3 c (Gain1 a b c d) where
  set33 :: c -> Gain1 a b c d -> Gain1 a b c d
set33 = c -> Gain1 a b c d -> Gain1 a b c d
forall c a b d. c -> Gain1 a b c d -> Gain1 a b c d
gainSet3

instance (Show c) => ThdParamSet3 c (Ladspa1 a b c) where
  set33 :: c -> Ladspa1 a b c -> Ladspa1 a b c
set33 = c -> Ladspa1 a b c -> Ladspa1 a b c
forall c a b. Show c => c -> Ladspa1 a b c -> Ladspa1 a b c
ladspaSet3

instance ThdParamSet3 c (Compand a b c d) where
  set33 :: c -> Compand a b c d -> Compand a b c d
set33 = c -> Compand a b c d -> Compand a b c d
forall c a b d. c -> Compand a b c d -> Compand a b c d
compandSet3

instance ThdParamSet3 a (Phaser a b)  where
  set33 :: a -> Phaser a b -> Phaser a b
set33 = Int -> a -> Phaser a b -> Phaser a b
forall a b. Int -> a -> Phaser a b -> Phaser a b
phaserSet1 Int
3

instance ThdParamSet3 c (Pitch a b c) where 
  set33 :: c -> Pitch a b c -> Pitch a b c
set33 = c -> Pitch a b c -> Pitch a b c
forall c a b. c -> Pitch a b c -> Pitch a b c
pitchSet3

instance ThdParamSet3 b2 (RateH a b1 b2 b3 b4 b5 c) where
  set33 :: b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
set33 = b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
forall b2 a b1 b3 b4 b5 c.
b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet22

instance ThdParamSetL3 c (Reverb a b c d) where 
  set33L :: [c] -> Reverb a b c d -> Reverb a b c d
set33L = [c] -> Reverb a b c d -> Reverb a b c d
forall c a b d. [c] -> Reverb a b c d -> Reverb a b c d
reverbSet3

instance ThdParamSet3 Float ReverbE where
  set33 :: Float -> ReverbE -> ReverbE
set33 = Int -> Float -> ReverbE -> ReverbE
reverbSet3E Int
3 

instance ThdParamSet3 c (AboveTSpec1 a b c) where
  set33 :: c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
set33 = c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
forall c a b. c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet3a

instance ThdParamSet3 c (BelowTSpec1 a b c) where 
  set33 :: c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
set33 = c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
forall c a b. c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet3b

instance ThdParamSet3 c (Silence a b c) where
  set33 :: c -> Silence a b c -> Silence a b c
set33 = c -> Silence a b c -> Silence a b c
forall c a b. c -> Silence a b c -> Silence a b c
silenceSet3
  
instance ThdParamSet3O c (Sinc a b c d) where 
  set33o :: One2 c -> Sinc a b c d -> Sinc a b c d
set33o = One2 c -> Sinc a b c d -> Sinc a b c d
forall c a b d. One2 c -> Sinc a b c d -> Sinc a b c d
sincSet3
    
instance ThdParamSetL3 c (Spectrogram3 a b c d e) where
  set33L :: [c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
set33L = [c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
forall c a b d e.
[c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet33

instance ThdParamSet3 a (StretchP a)  where
  set33 :: a -> StretchP a -> StretchP a
set33 = a -> StretchP a -> StretchP a
forall a. a -> StretchP a -> StretchP a
stretchSet3

instance ThdParamSet3 c (Tempo a b c d) where 
  set33 :: c -> Tempo a b c d -> Tempo a b c d
set33 = c -> Tempo a b c d -> Tempo a b c d
forall c a b d. c -> Tempo a b c d -> Tempo a b c d
tempoSet3

instance ThdParamSet3 Float Vol where
  set33 :: Float -> Vol -> Vol
set33 = Float -> Vol -> Vol
volSet3