-- |
-- Module      :  DobutokO.Sound.Effects.BassTreble
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the SoX \"bass\" or \"treble\" effects with the needed specifications. 
-- 

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

module DobutokO.Sound.Effects.BassTreble 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.Specs hiding (Width(..),Width1)
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data WidthS a = H a | K a | O a | Q a | S a deriving WidthS a -> WidthS a -> Bool
(WidthS a -> WidthS a -> Bool)
-> (WidthS a -> WidthS a -> Bool) -> Eq (WidthS a)
forall a. Eq a => WidthS a -> WidthS a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidthS a -> WidthS a -> Bool
$c/= :: forall a. Eq a => WidthS a -> WidthS a -> Bool
== :: WidthS a -> WidthS a -> Bool
$c== :: forall a. Eq a => WidthS a -> WidthS a -> Bool
Eq

instance Show (WidthS Float) where 
  show :: WidthS Float -> String
show (H Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
"h"
  show (K Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
"k"
  show (O Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
"o"
  show (Q Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
"q"
  show (S Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
"s"

type WidthS1 = WidthS Float

data FreqWidthS a b = FrS1 a | FrWS2 a b deriving FreqWidthS a b -> FreqWidthS a b -> Bool
(FreqWidthS a b -> FreqWidthS a b -> Bool)
-> (FreqWidthS a b -> FreqWidthS a b -> Bool)
-> Eq (FreqWidthS a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
FreqWidthS a b -> FreqWidthS a b -> Bool
/= :: FreqWidthS a b -> FreqWidthS a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
FreqWidthS a b -> FreqWidthS a b -> Bool
== :: FreqWidthS a b -> FreqWidthS a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
FreqWidthS a b -> FreqWidthS a b -> Bool
Eq

instance Show (FreqWidthS Freq1 WidthS1) where
  show :: FreqWidthS Freq1 (WidthS Float) -> String
show (FrS1 Freq1
x) = Freq1 -> String
forall a. Show a => a -> String
show Freq1
x
  show (FrWS2 Freq1
x WidthS Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Freq1 -> String
forall a. Show a => a -> String
show Freq1
x,String
" ",WidthS Float -> String
forall a. Show a => a -> String
show WidthS Float
y]

type FreqWS2 = FreqWidthS Freq1 WidthS1   

freqWidthSC :: FreqWidthS a b -> String
freqWidthSC :: FreqWidthS a b -> String
freqWidthSC (FrS1 a
_) = String
"FrS1"
freqWidthSC (FrWS2 a
_ b
_) = String
"FrWS2"

freqWidthS1 :: FreqWidthS a b -> a
freqWidthS1 :: FreqWidthS a b -> a
freqWidthS1 (FrS1 a
x) = a
x
freqWidthS1 (FrWS2 a
x b
_) = a
x

freqWidthS2 :: FreqWidthS a b -> Maybe b
freqWidthS2 :: FreqWidthS a b -> Maybe b
freqWidthS2 (FrS1 a
_) = Maybe b
forall a. Maybe a
Nothing
freqWidthS2 (FrWS2 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y

freqWidthSSet1 :: a -> FreqWidthS a b -> FreqWidthS a b
freqWidthSSet1 :: a -> FreqWidthS a b -> FreqWidthS a b
freqWidthSSet1 a
x (FrS1 a
_) = a -> FreqWidthS a b
forall a b. a -> FreqWidthS a b
FrS1 a
x
freqWidthSSet1 a
x (FrWS2 a
_ b
y) = a -> b -> FreqWidthS a b
forall a b. a -> b -> FreqWidthS a b
FrWS2 a
x b
y

freqWidthSSet2 :: b -> FreqWidthS a b -> FreqWidthS a b
freqWidthSSet2 :: b -> FreqWidthS a b -> FreqWidthS a b
freqWidthSSet2 b
y (FrS1 a
x) = a -> b -> FreqWidthS a b
forall a b. a -> b -> FreqWidthS a b
FrWS2 a
x b
y
freqWidthSSet2 b
y (FrWS2 a
x b
_) = a -> b -> FreqWidthS a b
forall a b. a -> b -> FreqWidthS a b
FrWS2 a
x b
y

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

instance Show (Bass Float FreqWS2) where
  show :: Bass Float (FreqWidthS Freq1 (WidthS Float)) -> String
show (Bs Float
x FreqWidthS Freq1 (WidthS Float)
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"bass ",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ",FreqWidthS Freq1 (WidthS Float) -> String
forall a. Show a => a -> String
show FreqWidthS Freq1 (WidthS Float)
y,String
" "]

type Bass1 = Bass Float FreqWS2

bass1 :: Bass a b -> a
bass1 :: Bass a b -> a
bass1 (Bs a
x b
_) = a
x

bass2 :: Bass a b -> b
bass2 :: Bass a b -> b
bass2 (Bs a
_ b
y) = b
y

bassSet1 :: a -> Bass a b -> Bass a b
bassSet1 :: a -> Bass a b -> Bass a b
bassSet1 a
x (Bs a
_ b
y) = a -> b -> Bass a b
forall a b. a -> b -> Bass a b
Bs a
x b
y

bassSet2 :: b -> Bass a b -> Bass a b
bassSet2 :: b -> Bass a b -> Bass a b
bassSet2 b
y (Bs a
x b
_) = a -> b -> Bass a b
forall a b. a -> b -> Bass a b
Bs a
x b
y

showBsQ :: Bass1 -> [String]
showBsQ :: Bass Float (FreqWidthS Freq1 (WidthS Float)) -> [String]
showBsQ = String -> [String]
words (String -> [String])
-> (Bass Float (FreqWidthS Freq1 (WidthS Float)) -> String)
-> Bass Float (FreqWidthS Freq1 (WidthS Float))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bass Float (FreqWidthS Freq1 (WidthS Float)) -> String
forall a. Show a => a -> String
show  

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

instance Show (Treble Float FreqWS2) where
  show :: Treble Float (FreqWidthS Freq1 (WidthS Float)) -> String
show (Tr Float
x FreqWidthS Freq1 (WidthS Float)
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"treble ",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ",FreqWidthS Freq1 (WidthS Float) -> String
forall a. Show a => a -> String
show FreqWidthS Freq1 (WidthS Float)
y,String
" "]

type Treble1 = Treble Float FreqWS2

treble1 :: Treble a b -> a
treble1 :: Treble a b -> a
treble1 (Tr a
x b
_) = a
x

treble2 :: Treble a b -> b
treble2 :: Treble a b -> b
treble2 (Tr a
_ b
y) = b
y

trebleSet1 :: a -> Treble a b -> Treble a b
trebleSet1 :: a -> Treble a b -> Treble a b
trebleSet1 a
x (Tr a
_ b
y) = a -> b -> Treble a b
forall a b. a -> b -> Treble a b
Tr a
x b
y

trebleSet2 :: b -> Treble a b -> Treble a b
trebleSet2 :: b -> Treble a b -> Treble a b
trebleSet2 b
y (Tr a
x b
_) = a -> b -> Treble a b
forall a b. a -> b -> Treble a b
Tr a
x b
y

showTrQ :: Treble1 -> [String]
showTrQ :: Treble Float (FreqWidthS Freq1 (WidthS Float)) -> [String]
showTrQ = String -> [String]
words (String -> [String])
-> (Treble Float (FreqWidthS Freq1 (WidthS Float)) -> String)
-> Treble Float (FreqWidthS Freq1 (WidthS Float))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Treble Float (FreqWidthS Freq1 (WidthS Float)) -> String
forall a. Show a => a -> String
show