-- |
-- Module      :  DobutokO.Sound.Effects.Misc
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying some of the SoX effects (first of all those ones without any passible parameters) 
-- and / or some of their combinations. 
-- 

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

module DobutokO.Sound.Effects.Misc 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 Misc = D | E | OO | RE | RI | S deriving Misc -> Misc -> Bool
(Misc -> Misc -> Bool) -> (Misc -> Misc -> Bool) -> Eq Misc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Misc -> Misc -> Bool
$c/= :: Misc -> Misc -> Bool
== :: Misc -> Misc -> Bool
$c== :: Misc -> Misc -> Bool
Eq

instance Show Misc where
  show :: Misc -> String
show Misc
D = String
"deemph "
  show Misc
E = String
"earwax "
  show Misc
OO = String
"oops "
  show Misc
RE = String
"reverse "
  show Misc
RI = String
"riaa "
  show Misc
S = String
"swap "

data MscS a = Msc [a] deriving MscS a -> MscS a -> Bool
(MscS a -> MscS a -> Bool)
-> (MscS a -> MscS a -> Bool) -> Eq (MscS a)
forall a. Eq a => MscS a -> MscS a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MscS a -> MscS a -> Bool
$c/= :: forall a. Eq a => MscS a -> MscS a -> Bool
== :: MscS a -> MscS a -> Bool
$c== :: forall a. Eq a => MscS a -> MscS a -> Bool
Eq

instance (Show a) => Show (MscS a) where
  show :: MscS a -> String
show (Msc [a]
ys) 
    | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys = []
    | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String]) -> ([a] -> [String]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ [a]
ys, String
" "]

type Mscs = MscS Misc

mscS1 :: MscS a -> [a]
mscS1 :: MscS a -> [a]
mscS1 (Msc [a]
xs) = [a]
xs

mscSSet1 :: [a] -> MscS a
mscSSet1 :: [a] -> MscS a
mscSSet1 = [a] -> MscS a
forall a. [a] -> MscS a
Msc

showMscQ :: Show a => MscS a -> [String]
showMscQ :: MscS a -> [String]
showMscQ = String -> [String]
words (String -> [String]) -> (MscS a -> String) -> MscS a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MscS a -> String
forall a. Show a => a -> String
show