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

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

module DobutokO.Sound.Effects.Noise 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 Noiseprof a = N | NP a deriving Noiseprof a -> Noiseprof a -> Bool
(Noiseprof a -> Noiseprof a -> Bool)
-> (Noiseprof a -> Noiseprof a -> Bool) -> Eq (Noiseprof a)
forall a. Eq a => Noiseprof a -> Noiseprof a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Noiseprof a -> Noiseprof a -> Bool
$c/= :: forall a. Eq a => Noiseprof a -> Noiseprof a -> Bool
== :: Noiseprof a -> Noiseprof a -> Bool
$c== :: forall a. Eq a => Noiseprof a -> Noiseprof a -> Bool
Eq

instance Show (Noiseprof FilePath) where
  show :: Noiseprof FilePath -> FilePath
show (NP FilePath
file) = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"noiseprof ",FilePath
file, FilePath
" "]
  show Noiseprof FilePath
_ = FilePath
"noiseprof "

type NoiseP = Noiseprof FilePath

noiseprofC :: Noiseprof a -> String
noiseprofC :: Noiseprof a -> FilePath
noiseprofC Noiseprof a
N = FilePath
"N"
noiseprofC Noiseprof a
_ = FilePath
"NP"

noiseprof1 :: Noiseprof a -> Maybe a
noiseprof1 :: Noiseprof a -> Maybe a
noiseprof1 (NP a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
noiseprof1 Noiseprof a
_ = Maybe a
forall a. Maybe a
Nothing

noiseprofSet1 :: a -> Noiseprof a
noiseprofSet1 :: a -> Noiseprof a
noiseprofSet1 = a -> Noiseprof a
forall a. a -> Noiseprof a
NP

showNPQ :: NoiseP -> [String]
showNPQ :: Noiseprof FilePath -> [FilePath]
showNPQ = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> (Noiseprof FilePath -> FilePath)
-> Noiseprof FilePath
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noiseprof FilePath -> FilePath
forall a. Show a => a -> FilePath
show 

data Noisered a b = NR | NR1 a | NR2 a b deriving Noisered a b -> Noisered a b -> Bool
(Noisered a b -> Noisered a b -> Bool)
-> (Noisered a b -> Noisered a b -> Bool) -> Eq (Noisered a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Noisered a b -> Noisered a b -> Bool
/= :: Noisered a b -> Noisered a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Noisered a b -> Noisered a b -> Bool
== :: Noisered a b -> Noisered a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Noisered a b -> Noisered a b -> Bool
Eq

instance Show (Noisered FilePath Float) where
  show :: Noisered FilePath Float -> FilePath
show (NR2 FilePath
file Float
x) = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"noisered ",ShowS
forall a. Show a => a -> FilePath
show FilePath
file, FilePath
" ", 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
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) FilePath
" "]
  show (NR1 FilePath
file) = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"noisered ",ShowS
forall a. Show a => a -> FilePath
show FilePath
file, FilePath
" "]
  show Noisered FilePath Float
_ = FilePath
"noisered - " -- the shell command will expect input from stdin. If it is not prepared, planned and available, do not use at all.

type NoiseR = Noisered FilePath Float

noiseredC :: Noisered a b -> String
noiseredC :: Noisered a b -> FilePath
noiseredC (NR2 a
_ b
_) = FilePath
"NR2"
noiseredC (NR1 a
_) = FilePath
"NR1"
noiseredC Noisered a b
_ = FilePath
"NR"

noisered1 :: Noisered a b -> Maybe a
noisered1 :: Noisered a b -> Maybe a
noisered1 (NR2 a
x b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
noisered1 (NR1 a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
noisered1 Noisered a b
_ = Maybe a
forall a. Maybe a
Nothing

noisered2 :: Noisered a b -> Maybe b
noisered2 :: Noisered a b -> Maybe b
noisered2 (NR2 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
noisered2 Noisered a b
_ = Maybe b
forall a. Maybe a
Nothing

noiseredSet1 :: a -> Noisered a b -> Noisered a b
noiseredSet1 :: a -> Noisered a b -> Noisered a b
noiseredSet1 a
x (NR2 a
_ b
y) = a -> b -> Noisered a b
forall a b. a -> b -> Noisered a b
NR2 a
x b
y
noiseredSet1 a
x Noisered a b
_ = a -> Noisered a b
forall a b. a -> Noisered a b
NR1 a
x

noiseredSet2 :: b -> Noisered a b -> Maybe (Noisered a b)
noiseredSet2 :: b -> Noisered a b -> Maybe (Noisered a b)
noiseredSet2 b
y (NR2 a
x b
_) = Noisered a b -> Maybe (Noisered a b)
forall a. a -> Maybe a
Just (a -> b -> Noisered a b
forall a b. a -> b -> Noisered a b
NR2 a
x b
y)
noiseredSet2 b
y (NR1 a
x) = Noisered a b -> Maybe (Noisered a b)
forall a. a -> Maybe a
Just (a -> b -> Noisered a b
forall a b. a -> b -> Noisered a b
NR2 a
x b
y)
noiseredSet2 b
_ Noisered a b
_ = Maybe (Noisered a b)
forall a. Maybe a
Nothing

showNRQ :: NoiseR -> [String]
showNRQ :: Noisered FilePath Float -> [FilePath]
showNRQ = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> (Noisered FilePath Float -> FilePath)
-> Noisered FilePath Float
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noisered FilePath Float -> FilePath
forall a. Show a => a -> FilePath
show