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

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

module DobutokO.Sound.Effects.Fade 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 Data.List (intersperse)

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

data FadeType = Q | HFt | TFt | L | P deriving FadeType -> FadeType -> Bool
(FadeType -> FadeType -> Bool)
-> (FadeType -> FadeType -> Bool) -> Eq FadeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FadeType -> FadeType -> Bool
$c/= :: FadeType -> FadeType -> Bool
== :: FadeType -> FadeType -> Bool
$c== :: FadeType -> FadeType -> Bool
Eq

instance Show FadeType where
  show :: FadeType -> String
show FadeType
Q = String
"q"
  show FadeType
HFt = String
"h"
  show FadeType
TFt = String
"t"
  show FadeType
L = String
"l"
  show FadeType
P = String
"p"

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

instance Show (Fade2 FadeType String) where
  show :: Fade2 FadeType String -> String
show (Fd FadeType
fdtype [String]
xss) 
   | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = []
   | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"fade ", FadeType -> String
forall a. Show a => a -> String
show FadeType
fdtype, String
" ", [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
xss]

fade1 :: Fade2 a b -> a
fade1 :: Fade2 a b -> a
fade1 (Fd a
y [b]
_) = a
y

fade2 :: Fade2 a b -> [b]
fade2 :: Fade2 a b -> [b]
fade2 (Fd a
_ [b]
xs) = Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
3 [b]
xs

fadeSet1 :: a -> Fade2 a b -> Fade2 a b
fadeSet1 :: a -> Fade2 a b -> Fade2 a b
fadeSet1 a
x (Fd a
_ [b]
ys) = a -> [b] -> Fade2 a b
forall a b. a -> [b] -> Fade2 a b
Fd a
x [b]
ys

fadeSet2 :: [b] -> Fade2 a b -> Fade2 a b
fadeSet2 :: [b] -> Fade2 a b -> Fade2 a b
fadeSet2 [b]
ys (Fd a
x [b]
_) = a -> [b] -> Fade2 a b
forall a b. a -> [b] -> Fade2 a b
Fd a
x (Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
3 [b]
ys)

type Fade = Fade2 FadeType String

fade2E :: Int -> Fade -> String
fade2E :: Int -> Fade2 FadeType String -> String
fade2E Int
n (Fd FadeType
_ [String]
xss) 
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss then String
" " else [String] -> String
forall a. [a] -> a
head [String]
xss
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
xss then String
" " else [String]
xss [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
xss then String
" " else [String]
xss [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2
 | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Fade.fade2E: The first argument is out of possible range [1..3]. "

fadeSet2E :: Int -> String -> Fade -> Fade
fadeSet2E :: Int -> String -> Fade2 FadeType String -> Fade2 FadeType String
fadeSet2E Int
n String
x (Fd FadeType
y [String]
xss) 
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
4 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xss) Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = FadeType -> [String] -> Fade2 FadeType String
forall a b. a -> [b] -> Fade2 a b
Fd FadeType
y ([[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String]
xss,[String
x],Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
n [String]
xss])
 | Bool
otherwise = String -> Fade2 FadeType String
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Fade.fadeSet2E: The first argument is out of possible defined ranges. "

showQFade :: Fade -> [String]
showQFade :: Fade2 FadeType String -> [String]
showQFade = String -> [String]
words (String -> [String])
-> (Fade2 FadeType String -> String)
-> Fade2 FadeType String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fade2 FadeType String -> String
forall a. Show a => a -> String
show