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

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

module DobutokO.Sound.Effects.Chorus where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif

import Numeric (showFFloat)
import DobutokO.Sound.Effects.Modulation2
import Data.List (intersperse)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data ChorusTail a b = ChT a a a a b deriving ChorusTail a b -> ChorusTail a b -> Bool
(ChorusTail a b -> ChorusTail a b -> Bool)
-> (ChorusTail a b -> ChorusTail a b -> Bool)
-> Eq (ChorusTail a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
ChorusTail a b -> ChorusTail a b -> Bool
/= :: ChorusTail a b -> ChorusTail a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
ChorusTail a b -> ChorusTail a b -> Bool
== :: ChorusTail a b -> ChorusTail a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
ChorusTail a b -> ChorusTail a b -> Bool
Eq

instance Show (ChorusTail Float Modulation) where
  show :: ChorusTail Float Modulation -> String
show (ChT Float
delay Float
decay Float
speed Float
depth Modulation
mod1) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
delay) String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
decay) String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
speed) String
" ", 
    Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
depth) String
" ", Modulation -> String
forall a. Show a => a -> String
show Modulation
mod1]

type ChorusTail1 = ChorusTail Float Modulation

data Chorus a b = Ch a a [b] deriving Chorus a b -> Chorus a b -> Bool
(Chorus a b -> Chorus a b -> Bool)
-> (Chorus a b -> Chorus a b -> Bool) -> Eq (Chorus a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Chorus a b -> Chorus a b -> Bool
/= :: Chorus a b -> Chorus a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Chorus a b -> Chorus a b -> Bool
== :: Chorus a b -> Chorus a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Chorus a b -> Chorus a b -> Bool
Eq

instance Show (Chorus Float ChorusTail1) where
  show :: Chorus Float (ChorusTail Float Modulation) -> String
show (Ch Float
gin Float
gout [ChorusTail Float Modulation]
ys) 
   | [ChorusTail Float Modulation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChorusTail Float Modulation]
ys = String
""
   | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"chorus ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
gin) String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
gout) String
" ", [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([ChorusTail Float Modulation] -> [String])
-> [ChorusTail Float Modulation]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([ChorusTail Float Modulation] -> [String])
-> [ChorusTail Float Modulation]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChorusTail Float Modulation -> String)
-> [ChorusTail Float Modulation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ChorusTail Float Modulation -> String
forall a. Show a => a -> String
show ([ChorusTail Float Modulation] -> String)
-> [ChorusTail Float Modulation] -> String
forall a b. (a -> b) -> a -> b
$ [ChorusTail Float Modulation]
ys]

type Chorus1 = Chorus Float ChorusTail1  

chorusTail1 :: Int -> ChorusTail a b -> a
chorusTail1 :: Int -> ChorusTail a b -> a
chorusTail1 Int
n (ChT a
x0 a
x1 a
x2 a
x3 b
_) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a
x0
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a
x1
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = a
x2
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = a
x3
  | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Chorus.chorusTail1: Not defined parameter. "
  
chorusTail2 :: ChorusTail a b -> b
chorusTail2 :: ChorusTail a b -> b
chorusTail2 (ChT a
_ a
_ a
_ a
_ b
y) = b
y

chorusTailSet1 :: Int -> a -> ChorusTail a b -> ChorusTail a b
chorusTailSet1 :: Int -> a -> ChorusTail a b -> ChorusTail a b
chorusTailSet1 Int
n a
x (ChT a
x0 a
x1 a
x2 a
x3 b
y) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> a -> a -> a -> b -> ChorusTail a b
forall a b. a -> a -> a -> a -> b -> ChorusTail a b
ChT a
x a
x1 a
x2 a
x3 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a -> a -> a -> a -> b -> ChorusTail a b
forall a b. a -> a -> a -> a -> b -> ChorusTail a b
ChT a
x0 a
x a
x2 a
x3 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = a -> a -> a -> a -> b -> ChorusTail a b
forall a b. a -> a -> a -> a -> b -> ChorusTail a b
ChT a
x0 a
x1 a
x a
x3 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = a -> a -> a -> a -> b -> ChorusTail a b
forall a b. a -> a -> a -> a -> b -> ChorusTail a b
ChT a
x0 a
x1 a
x2 a
x b
y
  | Bool
otherwise = String -> ChorusTail a b
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Chorus.chorusTailSet1: Not defined parameter. "

chorusTailSet2 :: b -> ChorusTail a b -> ChorusTail a b
chorusTailSet2 :: b -> ChorusTail a b -> ChorusTail a b
chorusTailSet2 b
y (ChT a
x0 a
x1 a
x2 a
x3 b
_) = a -> a -> a -> a -> b -> ChorusTail a b
forall a b. a -> a -> a -> a -> b -> ChorusTail a b
ChT a
x0 a
x1 a
x2 a
x3 b
y

chorus1 :: Int -> Chorus a b -> a
chorus1 :: Int -> Chorus a b -> a
chorus1 Int
n (Ch a
x0 a
x1 [b]
_) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a
x0
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a
x1
  | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Chorus.chorus1: Not defined parameter. "
  
chorus2 :: Chorus a b -> [b]
chorus2 :: Chorus a b -> [b]
chorus2 (Ch a
_ a
_ [b]
ys) = [b]
ys

chorusSet1 :: Int -> a -> Chorus a b -> Chorus a b
chorusSet1 :: Int -> a -> Chorus a b -> Chorus a b
chorusSet1 Int
n a
x (Ch a
x0 a
x1 [b]
y) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> a -> [b] -> Chorus a b
forall a b. a -> a -> [b] -> Chorus a b
Ch a
x a
x1 [b]
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a -> a -> [b] -> Chorus a b
forall a b. a -> a -> [b] -> Chorus a b
Ch a
x0 a
x [b]
y
  | Bool
otherwise = String -> Chorus a b
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Chorus.chorusSet1: Not defined parameter. "

chorusSet2 :: [b] -> Chorus a b -> Chorus a b
chorusSet2 :: [b] -> Chorus a b -> Chorus a b
chorusSet2 [b]
ys (Ch a
x0 a
x1 [b]
_) = a -> a -> [b] -> Chorus a b
forall a b. a -> a -> [b] -> Chorus a b
Ch a
x0 a
x1 [b]
ys

showChQ :: Chorus1 -> [String]
showChQ :: Chorus Float (ChorusTail Float Modulation) -> [String]
showChQ = String -> [String]
words (String -> [String])
-> (Chorus Float (ChorusTail Float Modulation) -> String)
-> Chorus Float (ChorusTail Float Modulation)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chorus Float (ChorusTail Float Modulation) -> String
forall a. Show a => a -> String
show