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

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

module DobutokO.Sound.Effects.Stat 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.Effects.Misc (MscS(..))

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

data StatP a = S a | RMS | V | Freq | D deriving StatP a -> StatP a -> Bool
(StatP a -> StatP a -> Bool)
-> (StatP a -> StatP a -> Bool) -> Eq (StatP a)
forall a. Eq a => StatP a -> StatP a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatP a -> StatP a -> Bool
$c/= :: forall a. Eq a => StatP a -> StatP a -> Bool
== :: StatP a -> StatP a -> Bool
$c== :: forall a. Eq a => StatP a -> StatP a -> Bool
Eq

instance Show (StatP Float) where
  show :: StatP Float -> String
show (S Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-s ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" "]
  show StatP Float
RMS = String
"-rms "
  show StatP Float
V = String
"-v "
  show StatP Float
D = String
"-d "
  show StatP Float
_ = String
"-freq "

type StatP1 = StatP Float

statPC :: StatP a -> String
statPC :: StatP a -> String
statPC (S a
_)   = String
"S"
statPC StatP a
RMS = String
"RMS"
statPC StatP a
V = String
"V"
statPC StatP a
D = String
"D"
statPC StatP a
_ = String
"Freq"

statP1 :: StatP a -> Maybe a
statP1 :: StatP a -> Maybe a
statP1 (S a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
statP1 StatP a
_ = Maybe a
forall a. Maybe a
Nothing

statPSet1 :: a -> StatP a
statPSet1 :: a -> StatP a
statPSet1 = a -> StatP a
forall a. a -> StatP a
S

data Stat1 a = ST (MscS a) deriving Stat1 a -> Stat1 a -> Bool
(Stat1 a -> Stat1 a -> Bool)
-> (Stat1 a -> Stat1 a -> Bool) -> Eq (Stat1 a)
forall a. Eq a => Stat1 a -> Stat1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stat1 a -> Stat1 a -> Bool
$c/= :: forall a. Eq a => Stat1 a -> Stat1 a -> Bool
== :: Stat1 a -> Stat1 a -> Bool
$c== :: forall a. Eq a => Stat1 a -> Stat1 a -> Bool
Eq

instance Show (Stat1 StatP1) where
  show :: Stat1 (StatP Float) -> String
show (ST (Msc [StatP Float]
xs)) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"stat ", MscS (StatP Float) -> String
forall a. Show a => a -> String
show ([StatP Float] -> MscS (StatP Float)
forall a. [a] -> MscS a
Msc [StatP Float]
xs)]

type Stat = Stat1 StatP1

stat11 :: Stat1 a -> [a]
stat11 :: Stat1 a -> [a]
stat11 (ST (Msc [a]
xs)) = [a]
xs

stat1Set1 :: [a] -> Stat1 a
stat1Set1 :: [a] -> Stat1 a
stat1Set1 [a]
xs = MscS a -> Stat1 a
forall a. MscS a -> Stat1 a
ST ([a] -> MscS a
forall a. [a] -> MscS a
Msc [a]
xs)

showSTQ :: Stat -> [String]
showSTQ :: Stat1 (StatP Float) -> [String]
showSTQ = String -> [String]
words (String -> [String])
-> (Stat1 (StatP Float) -> String)
-> Stat1 (StatP Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stat1 (StatP Float) -> String
forall a. Show a => a -> String
show