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

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

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

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

data Fir a b = CF a | Cs [b] | EF deriving Fir a b -> Fir a b -> Bool
(Fir a b -> Fir a b -> Bool)
-> (Fir a b -> Fir a b -> Bool) -> Eq (Fir a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Fir a b -> Fir a b -> Bool
/= :: Fir a b -> Fir a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Fir a b -> Fir a b -> Bool
== :: Fir a b -> Fir a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Fir a b -> Fir a b -> Bool
Eq

instance Show (Fir FilePath Float) where
  show :: Fir FilePath Float -> FilePath
show (CF FilePath
file) = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"fir ", FilePath
file, FilePath
" "]
  show (Cs [Float]
xs) = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"fir ", [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([Float] -> [FilePath]) -> [Float] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
" " ([FilePath] -> [FilePath])
-> ([Float] -> [FilePath]) -> [Float] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> FilePath) -> [Float] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
x -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x FilePath
" ") ([Float] -> FilePath) -> [Float] -> FilePath
forall a b. (a -> b) -> a -> b
$ [Float]
xs]
  show Fir FilePath Float
_ = FilePath
"" -- the shell command will expect input from stdin. If it is not prepared, planned and available, do not use at all.

type FIR = Fir FilePath Float

firC :: Fir a b -> String
firC :: Fir a b -> FilePath
firC (CF a
_) = FilePath
"CF"
firC (Cs [b]
_) = FilePath
"Cs"
firC Fir a b
_ =FilePath
"EF"

fir1 :: Fir a b -> Maybe a
fir1 :: Fir a b -> Maybe a
fir1 (CF a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
fir1 Fir a b
_ = Maybe a
forall a. Maybe a
Nothing

fir2 :: Fir a b -> Maybe [b]
fir2 :: Fir a b -> Maybe [b]
fir2 (Cs [b]
xs) = [b] -> Maybe [b]
forall a. a -> Maybe a
Just [b]
xs
fir2 Fir a b
_ = Maybe [b]
forall a. Maybe a
Nothing

firSet1 :: a -> Fir a b
firSet1 :: a -> Fir a b
firSet1 = a -> Fir a b
forall a b. a -> Fir a b
CF

firSet2 :: [b] -> Fir a b
firSet2 :: [b] -> Fir a b
firSet2 = [b] -> Fir a b
forall a b. [b] -> Fir a b
Cs

showFIRQ :: FIR -> [String]
showFIRQ :: Fir FilePath Float -> [FilePath]
showFIRQ = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> (Fir FilePath Float -> FilePath)
-> Fir FilePath Float
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fir FilePath Float -> FilePath
forall a. Show a => a -> FilePath
show