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

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

module DobutokO.Sound.Effects.Stats 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(..),mscS1)
import DobutokO.Sound.ToRange

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

data StatsP a = E | B a | X a | S a deriving StatsP a -> StatsP a -> Bool
(StatsP a -> StatsP a -> Bool)
-> (StatsP a -> StatsP a -> Bool) -> Eq (StatsP a)
forall a. Eq a => StatsP a -> StatsP a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatsP a -> StatsP a -> Bool
$c/= :: forall a. Eq a => StatsP a -> StatsP a -> Bool
== :: StatsP a -> StatsP a -> Bool
$c== :: forall a. Eq a => StatsP a -> StatsP a -> Bool
Eq

instance Show (StatsP Float) where
  show :: StatsP Float -> String
show (B Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-b ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x) Float
2.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
2.0 else (Float -> Float -> Float
toRange Float
32.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)) String
" "]
  show (X Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-x ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x) Float
2.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
2.0 else (Float -> Float -> Float
toRange Float
32.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)) 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 -> Float -> Float
toRange Float
99.0 Float
x) String
" "]
  show StatsP Float
_ = String
""

type StatsPF = StatsP Float

statsPC :: StatsP a -> String
statsPC :: StatsP a -> String
statsPC (B a
_) = String
"B"
statsPC (X a
_) = String
"X"
statsPC (S a
_) = String
"S"
statsPC StatsP a
_ = String
"E"

statsP1 :: StatsP a -> Maybe a
statsP1 :: StatsP a -> Maybe a
statsP1 (B a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
statsP1 (X a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
statsP1 (S a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
statsP1 StatsP a
_ = Maybe a
forall a. Maybe a
Nothing

statsPSet1 :: a -> StatsP a -> StatsP a
statsPSet1 :: a -> StatsP a -> StatsP a
statsPSet1 a
x (B a
_) = a -> StatsP a
forall a. a -> StatsP a
B a
x
statsPSet1 a
x (X a
_) = a -> StatsP a
forall a. a -> StatsP a
X a
x
statsPSet1 a
x (S a
_) = a -> StatsP a
forall a. a -> StatsP a
S a
x
statsPSet1 a
_ StatsP a
_ = StatsP a
forall a. StatsP a
E

data Window1 a = E0 | W a deriving Window1 a -> Window1 a -> Bool
(Window1 a -> Window1 a -> Bool)
-> (Window1 a -> Window1 a -> Bool) -> Eq (Window1 a)
forall a. Eq a => Window1 a -> Window1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Window1 a -> Window1 a -> Bool
$c/= :: forall a. Eq a => Window1 a -> Window1 a -> Bool
== :: Window1 a -> Window1 a -> Bool
$c== :: forall a. Eq a => Window1 a -> Window1 a -> Bool
Eq

instance Show (Window1 Float) where
  show :: Window1 Float -> String
show (W Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-w ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x) Float
0.01 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.01 else (Float -> Float -> Float
toRange Float
10.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)) String
" "]
  show Window1 Float
_ = String
""

type Window = Window1 Float

window1C :: Window1 a -> String
window1C :: Window1 a -> String
window1C Window1 a
E0 = String
"E0"
window1C Window1 a
_ = String
"W"

window11 :: Window1 a -> Maybe a
window11 :: Window1 a -> Maybe a
window11 (W a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
window11 Window1 a
_ = Maybe a
forall a. Maybe a
Nothing

window1Set1 :: a -> Window1 a
window1Set1 :: a -> Window1 a
window1Set1 = a -> Window1 a
forall a. a -> Window1 a
W

data Stats2 a b = STT (MscS a) (MscS b) deriving Stats2 a b -> Stats2 a b -> Bool
(Stats2 a b -> Stats2 a b -> Bool)
-> (Stats2 a b -> Stats2 a b -> Bool) -> Eq (Stats2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Stats2 a b -> Stats2 a b -> Bool
/= :: Stats2 a b -> Stats2 a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Stats2 a b -> Stats2 a b -> Bool
== :: Stats2 a b -> Stats2 a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Stats2 a b -> Stats2 a b -> Bool
Eq

instance Show (Stats2 StatsPF Window) where
  show :: Stats2 (StatsP Float) (Window1 Float) -> String
show (STT MscS (StatsP Float)
x MscS (Window1 Float)
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"stats ", MscS (StatsP Float) -> String
forall a. Show a => a -> String
show MscS (StatsP Float)
x, MscS (Window1 Float) -> String
forall a. Show a => a -> String
show MscS (Window1 Float)
y]

type Stats = Stats2 StatsPF Window

stats21 :: Stats2 a b -> [a]
stats21 :: Stats2 a b -> [a]
stats21 (STT MscS a
x MscS b
_) = MscS a -> [a]
forall a. MscS a -> [a]
mscS1 MscS a
x

stats22 :: Stats2 a b -> [b]
stats22 :: Stats2 a b -> [b]
stats22 (STT MscS a
_ MscS b
y) = MscS b -> [b]
forall a. MscS a -> [a]
mscS1 MscS b
y

stats2Set1 :: [a] -> Stats2 a b -> Stats2 a b
stats2Set1 :: [a] -> Stats2 a b -> Stats2 a b
stats2Set1 [a]
xs (STT MscS a
_ MscS b
y) = MscS a -> MscS b -> Stats2 a b
forall a b. MscS a -> MscS b -> Stats2 a b
STT ([a] -> MscS a
forall a. [a] -> MscS a
Msc [a]
xs) MscS b
y

stats2Set2 :: [b] -> Stats2 a b -> Stats2 a b
stats2Set2 :: [b] -> Stats2 a b -> Stats2 a b
stats2Set2 [b]
ys (STT MscS a
x MscS b
_) = MscS a -> MscS b -> Stats2 a b
forall a b. MscS a -> MscS b -> Stats2 a b
STT MscS a
x ([b] -> MscS b
forall a. [a] -> MscS a
Msc [b]
ys)

showSTTQ :: Stats -> [String]
showSTTQ :: Stats2 (StatsP Float) (Window1 Float) -> [String]
showSTTQ = String -> [String]
words (String -> [String])
-> (Stats2 (StatsP Float) (Window1 Float) -> String)
-> Stats2 (StatsP Float) (Window1 Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats2 (StatsP Float) (Window1 Float) -> String
forall a. Show a => a -> String
show