-- |
-- Module      :  DobutokO.Sound.Effects.Classes.FourthParam
-- 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.FourthParam 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 FourthParam a b where
  get4 :: a -> b

class FourthParamL a b where
  get4L :: a -> [b]

class FourthParamM a b where
  get4m :: a -> Maybe b  
  
instance FourthParam (ChorusTail a b) a where
  get4 :: ChorusTail a b -> a
get4 = Int -> ChorusTail a b -> a
forall a b. Int -> ChorusTail a b -> a
chorusTail1 Int
4

instance FourthParam (Gain1 a b c d) d where
  get4 :: Gain1 a b c d -> d
get4 = Gain1 a b c d -> d
forall a b c d. Gain1 a b c d -> d
gain4

instance FourthParamM (Compand a b c d) d where
  get4m :: Compand a b c d -> Maybe d
get4m = Compand a b c d -> Maybe d
forall a b c d. Compand a b c d -> Maybe d
compand4

instance FourthParam (Phaser a b) a where
  get4 :: Phaser a b -> a
get4 = Int -> Phaser a b -> a
forall a b. Int -> Phaser a b -> a
phaser1 Int
4

instance FourthParam (RateH a b1 b2 b3 b4 b5 c) b3 where
  get4 :: RateH a b1 b2 b3 b4 b5 c -> b3
get4 = RateH a b1 b2 b3 b4 b5 c -> b3
forall a b1 b2 b3 b4 b5 c. RateH a b1 b2 b3 b4 b5 c -> b3
rateH23

instance FourthParam (Reverb a b c d) d where 
  get4 :: Reverb a b c d -> d
get4 = Reverb a b c d -> d
forall a b c d. Reverb a b c d -> d
reverb4

instance FourthParam ReverbE Float where
  get4 :: ReverbE -> Float
get4 = Int -> ReverbE -> Float
reverb3E Int
4
  
instance FourthParam (Sinc a b c d) d where 
  get4 :: Sinc a b c d -> d
get4 = Sinc a b c d -> d
forall a b c d. Sinc a b c d -> d
sinc4

instance FourthParamL (Spectrogram3 a b c d e) d where
  get4L :: Spectrogram3 a b c d e -> [d]
get4L = Spectrogram3 a b c d e -> [d]
forall a b c d e. Spectrogram3 a b c d e -> [d]
spectrogram34

instance FourthParamM (Tempo a b c d) d where 
  get4m :: Tempo a b c d -> Maybe d
get4m = Tempo a b c d -> Maybe d
forall a b c d. Tempo a b c d -> Maybe d
tempo4

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

class FifthParam a b where
  get5 :: a -> b

class FifthParamL a b where
  get5L :: a -> [b]

instance FifthParam (Phaser a b) a where
  get5 :: Phaser a b -> a
get5 = Int -> Phaser a b -> a
forall a b. Int -> Phaser a b -> a
phaser1 Int
5

instance FifthParam (RateH a b1 b2 b3 b4 b5 c) b4 where
  get5 :: RateH a b1 b2 b3 b4 b5 c -> b4
get5 = RateH a b1 b2 b3 b4 b5 c -> b4
forall a b1 b2 b3 b4 b5 c. RateH a b1 b2 b3 b4 b5 c -> b4
rateH24

instance FifthParam ReverbE Float where
  get5 :: ReverbE -> Float
get5 = Int -> ReverbE -> Float
reverb3E Int
5

instance FifthParamL (Spectrogram3 a b c d e) e where
  get5L :: Spectrogram3 a b c d e -> [e]
get5L = Spectrogram3 a b c d e -> [e]
forall a b c d e. Spectrogram3 a b c d e -> [e]
spectrogram35

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

class SixthParam a b where
  get6 :: a -> b

instance SixthParam (Phaser a b) b where
  get6 :: Phaser a b -> b
get6 = Phaser a b -> b
forall a b. Phaser a b -> b
phaser2

instance SixthParam (RateH a b1 b2 b3 b4 b5 c) b5 where
  get6 :: RateH a b1 b2 b3 b4 b5 c -> b5
get6 = RateH a b1 b2 b3 b4 b5 c -> b5
forall a b1 b2 b3 b4 b5 c. RateH a b1 b2 b3 b4 b5 c -> b5
rateH25

instance SixthParam ReverbE Float where
  get6 :: ReverbE -> Float
get6 = Int -> ReverbE -> Float
reverb3E Int
6

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

class SeventhParam a b where
  get7 :: a -> b

instance SeventhParam (RateH a b1 b2 b3 b4 b5 c) c where
  get7 :: RateH a b1 b2 b3 b4 b5 c -> c
get7 = RateH a b1 b2 b3 b4 b5 c -> c
forall a b1 b2 b3 b4 b5 c. RateH a b1 b2 b3 b4 b5 c -> c
rateH3

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