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

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

module DobutokO.Sound.Effects.DCShift 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 DobutokO.Sound.ToRange
import Numeric (showFFloat)

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

data DCShift a b = DC1 a | DC2 a b deriving DCShift a b -> DCShift a b -> Bool
(DCShift a b -> DCShift a b -> Bool)
-> (DCShift a b -> DCShift a b -> Bool) -> Eq (DCShift a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => DCShift a b -> DCShift a b -> Bool
/= :: DCShift a b -> DCShift a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => DCShift a b -> DCShift a b -> Bool
== :: DCShift a b -> DCShift a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => DCShift a b -> DCShift a b -> Bool
Eq

instance Show (DCShift Float Float) where
  show :: DCShift Float Float -> String
show (DC1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dcshift ", 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
2.0 Float
x) String
" "]
  show (DC2 Float
x Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dcshift ", 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
2.0 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
0.1 (Float -> Float
forall a. Num a => a -> a
abs Float
y)) String
" "]

type DCSh = DCShift Float Float

dcShiftC :: DCShift a b -> String
dcShiftC :: DCShift a b -> String
dcShiftC (DC1 a
_) = String
"DC1"
dcShiftC DCShift a b
_ = String
"DC2"

dcShift1 :: DCShift a b -> a
dcShift1 :: DCShift a b -> a
dcShift1 (DC1 a
x) = a
x
dcShift1 (DC2 a
x b
_) = a
x

dcShift2 :: DCShift a b -> Maybe b
dcShift2 :: DCShift a b -> Maybe b
dcShift2 (DC2 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
dcShift2 DCShift a b
_ = Maybe b
forall a. Maybe a
Nothing

dcShiftSet1 :: a -> DCShift a b -> DCShift a b
dcShiftSet1 :: a -> DCShift a b -> DCShift a b
dcShiftSet1 a
x (DC1 a
_) = a -> DCShift a b
forall a b. a -> DCShift a b
DC1 a
x
dcShiftSet1 a
x (DC2 a
_ b
y) = a -> b -> DCShift a b
forall a b. a -> b -> DCShift a b
DC2 a
x b
y

dcShiftSet2 :: b -> DCShift a b -> DCShift a b
dcShiftSet2 :: b -> DCShift a b -> DCShift a b
dcShiftSet2 b
y (DC1 a
x) = a -> b -> DCShift a b
forall a b. a -> b -> DCShift a b
DC2 a
x b
y
dcShiftSet2 b
y (DC2 a
x b
_) = a -> b -> DCShift a b
forall a b. a -> b -> DCShift a b
DC2 a
x b
y

showDCQ :: DCSh -> [String]
showDCQ :: DCShift Float Float -> [String]
showDCQ = String -> [String]
words (String -> [String])
-> (DCShift Float Float -> String)
-> DCShift Float Float
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DCShift Float Float -> String
forall a. Show a => a -> String
show