-- |
-- Module      :  DobutokO.Sound.Effects.Classes.FourthParamSet
-- 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.FourthParamSet where

import DobutokO.Sound.Effects.Chorus
import DobutokO.Sound.Effects.Gain
import DobutokO.Sound.Effects.MCompand
import DobutokO.Sound.Effects.Phaser
import DobutokO.Sound.Effects.Rate
import DobutokO.Sound.Effects.Reverb
import DobutokO.Sound.Effects.Sinc
import DobutokO.Sound.Effects.Spectrogram
import DobutokO.Sound.Effects.Tempo

class FourthParamSet3 a b where
  set43 :: a -> b -> b

class FourthParamSetL3 a b where
  set43L :: [a] -> b -> b
  
instance FourthParamSet3 a (ChorusTail a b) where
  set43 :: a -> ChorusTail a b -> ChorusTail a b
set43 = Int -> a -> ChorusTail a b -> ChorusTail a b
forall a b. Int -> a -> ChorusTail a b -> ChorusTail a b
chorusTailSet1 Int
4

instance FourthParamSet3 d (Gain1 a b c d) where
  set43 :: d -> Gain1 a b c d -> Gain1 a b c d
set43 = d -> Gain1 a b c d -> Gain1 a b c d
forall d a b c. d -> Gain1 a b c d -> Gain1 a b c d
gainSet4

instance FourthParamSet3 d (Compand a b c d) where
  set43 :: d -> Compand a b c d -> Compand a b c d
set43 = d -> Compand a b c d -> Compand a b c d
forall d a b c. d -> Compand a b c d -> Compand a b c d
compandSet4

instance FourthParamSet3 a (Phaser a b) where
  set43 :: a -> Phaser a b -> Phaser a b
set43 = Int -> a -> Phaser a b -> Phaser a b
forall a b. Int -> a -> Phaser a b -> Phaser a b
phaserSet1 Int
4

instance FourthParamSet3 b3 (RateH a b1 b2 b3 b4 b5 c) where
  set43 :: b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
set43 = b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
forall b3 a b1 b2 b4 b5 c.
b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet23

instance FourthParamSet3 d (Reverb a b c d) where 
  set43 :: d -> Reverb a b c d -> Reverb a b c d
set43 = d -> Reverb a b c d -> Reverb a b c d
forall d a b c. d -> Reverb a b c d -> Reverb a b c d
reverbSet4

instance FourthParamSet3 Float ReverbE where
  set43 :: Float -> ReverbE -> ReverbE
set43 = Int -> Float -> ReverbE -> ReverbE
reverbSet3E Int
4
  
instance FourthParamSet3 d (Sinc a b c d) where 
  set43 :: d -> Sinc a b c d -> Sinc a b c d
set43 = d -> Sinc a b c d -> Sinc a b c d
forall d a b c. d -> Sinc a b c d -> Sinc a b c d
sincSet4

instance FourthParamSetL3 d (Spectrogram3 a b c d e) where
  set43L :: [d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
set43L = [d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
forall d a b c e.
[d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet34

instance FourthParamSet3 d (Tempo a b c d) where 
  set43 :: d -> Tempo a b c d -> Tempo a b c d
set43 = d -> Tempo a b c d -> Tempo a b c d
forall d a b c. d -> Tempo a b c d -> Tempo a b c d
tempoSet4

------------------------------------------------------------------------------------------

class FifthParamSet3 a b where
  set53 :: a -> b -> b

class FifthParamSetL3 a b where
  set53L :: [a] -> b -> b

instance FifthParamSet3 a (Phaser a b) where
  set53 :: a -> Phaser a b -> Phaser a b
set53 = Int -> a -> Phaser a b -> Phaser a b
forall a b. Int -> a -> Phaser a b -> Phaser a b
phaserSet1 Int
5

instance FifthParamSet3 b4 (RateH a b1 b2 b3 b4 b5 c) where
  set53 :: b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
set53 = b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
forall b4 a b1 b2 b3 b5 c.
b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet24

instance FifthParamSet3 Float ReverbE where
  set53 :: Float -> ReverbE -> ReverbE
set53 = Int -> Float -> ReverbE -> ReverbE
reverbSet3E Int
5

instance FifthParamSetL3 e (Spectrogram3 a b c d e) where
  set53L :: [e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
set53L = [e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
forall e a b c d.
[e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet35

------------------------------------------------------------------------------------------

class SixthParamSet3 a b where
  set63 :: a -> b -> b

instance SixthParamSet3 b (Phaser a b) where
  set63 :: b -> Phaser a b -> Phaser a b
set63 = b -> Phaser a b -> Phaser a b
forall b a. b -> Phaser a b -> Phaser a b
phaserSet2

instance SixthParamSet3 b5 (RateH a b1 b2 b3 b4 b5 c) where
  set63 :: b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
set63 = b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
forall b5 a b1 b2 b3 b4 c.
b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet25

instance SixthParamSet3 Float ReverbE where
  set63 :: Float -> ReverbE -> ReverbE
set63 = Int -> Float -> ReverbE -> ReverbE
reverbSet3E Int
6

------------------------------------------------------------------------------------------

class SeventhParamSet3 a b where
  set73 :: a -> b -> b

instance SeventhParamSet3 c (RateH a b1 b2 b3 b4 b5 c) where
  set73 :: c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
set73 = c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
forall c a b1 b2 b3 b4 b5.
c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet3

-- ========================================================================================