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

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

module DobutokO.Sound.Effects.Overdrive 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.ToRange

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

data Overdrive a = OD | OD1 a | OD2 a a deriving Overdrive a -> Overdrive a -> Bool
(Overdrive a -> Overdrive a -> Bool)
-> (Overdrive a -> Overdrive a -> Bool) -> Eq (Overdrive a)
forall a. Eq a => Overdrive a -> Overdrive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Overdrive a -> Overdrive a -> Bool
$c/= :: forall a. Eq a => Overdrive a -> Overdrive a -> Bool
== :: Overdrive a -> Overdrive a -> Bool
$c== :: forall a. Eq a => Overdrive a -> Overdrive a -> Bool
Eq

instance Show (Overdrive Float) where
  show :: Overdrive Float -> String
show (OD1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"overdrive ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
100.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)) String
" "]
  show (OD2 Float
x Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"overdrive ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
100.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)) String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
100.0 (Float -> Float
forall a. Num a => a -> a
abs Float
y)) String
" "]
  show Overdrive Float
_ = String
"overdrive "

type Ovdrive = Overdrive Float

overdriveC :: Overdrive a -> String
overdriveC :: Overdrive a -> String
overdriveC Overdrive a
OD = String
"OD"
overdriveC (OD1 a
_) = String
"OD1"
overdriveC Overdrive a
_ = String
"OD2"

overdrive1 :: Overdrive a -> Maybe a
overdrive1 :: Overdrive a -> Maybe a
overdrive1 (OD1 a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
overdrive1 (OD2 a
x a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
overdrive1 Overdrive a
_ = Maybe a
forall a. Maybe a
Nothing

overdrive2 :: Overdrive a -> Maybe a
overdrive2 :: Overdrive a -> Maybe a
overdrive2 (OD2 a
_ a
y) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
overdrive2 Overdrive a
_ = Maybe a
forall a. Maybe a
Nothing

overdriveSet1 :: a -> Overdrive a -> Overdrive a
overdriveSet1 :: a -> Overdrive a -> Overdrive a
overdriveSet1 a
x (OD2 a
_ a
y) = a -> a -> Overdrive a
forall a. a -> a -> Overdrive a
OD2 a
x a
y
overdriveSet1 a
x Overdrive a
_ = a -> Overdrive a
forall a. a -> Overdrive a
OD1 a
x

overdriveSet2 :: a -> Overdrive a -> Maybe (Overdrive a)
overdriveSet2 :: a -> Overdrive a -> Maybe (Overdrive a)
overdriveSet2 a
y (OD2 a
x a
_) = Overdrive a -> Maybe (Overdrive a)
forall a. a -> Maybe a
Just (a -> a -> Overdrive a
forall a. a -> a -> Overdrive a
OD2 a
x a
y)
overdriveSet2 a
y (OD1 a
x) = Overdrive a -> Maybe (Overdrive a)
forall a. a -> Maybe a
Just (a -> a -> Overdrive a
forall a. a -> a -> Overdrive a
OD2 a
x a
y)
overdriveSet2 a
_ Overdrive a
_ = Maybe (Overdrive a)
forall a. Maybe a
Nothing

showODQ :: Ovdrive -> [String]
showODQ :: Overdrive Float -> [String]
showODQ = String -> [String]
words (String -> [String])
-> (Overdrive Float -> String) -> Overdrive Float -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overdrive Float -> String
forall a. Show a => a -> String
show