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

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

module DobutokO.Sound.Effects.Silence 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
import DobutokO.Sound.Effects.Timespec (TimeSpec(..),NextTSpec)

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

data LeftIntact = L | Nl deriving LeftIntact -> LeftIntact -> Bool
(LeftIntact -> LeftIntact -> Bool)
-> (LeftIntact -> LeftIntact -> Bool) -> Eq LeftIntact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeftIntact -> LeftIntact -> Bool
$c/= :: LeftIntact -> LeftIntact -> Bool
== :: LeftIntact -> LeftIntact -> Bool
$c== :: LeftIntact -> LeftIntact -> Bool
Eq

instance Show LeftIntact where
  show :: LeftIntact -> String
show LeftIntact
L = String
"-l "
  show LeftIntact
_ = String
""

data Threshold a = T1 a | D1 a | P1 a deriving Threshold a -> Threshold a -> Bool
(Threshold a -> Threshold a -> Bool)
-> (Threshold a -> Threshold a -> Bool) -> Eq (Threshold a)
forall a. Eq a => Threshold a -> Threshold a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Threshold a -> Threshold a -> Bool
$c/= :: forall a. Eq a => Threshold a -> Threshold a -> Bool
== :: Threshold a -> Threshold a -> Bool
$c== :: forall a. Eq a => Threshold a -> Threshold a -> Bool
Eq

instance Show (Threshold Float) where
  show :: Threshold Float -> String
show (T1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Integer -> String
forall a. Show a => a -> String
show (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Integer) -> (Float -> Float) -> Float -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
x), String
" "]
  show (P1 Float
x) = 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
100.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 (D1 Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then -Float
0.01 else -Float -> Float
forall a. Num a => a -> a
abs Float
x) String
"d "

type Threshold1 = Threshold Float

thresholdC :: Threshold a -> String
thresholdC :: Threshold a -> String
thresholdC (T1 a
_) = String
"T1"
thresholdC (D1 a
_) = String
"D1"
thresholdC Threshold a
_ = String
"P1"

threshold1 :: Threshold a -> a
threshold1 :: Threshold a -> a
threshold1 (T1 a
x) = a
x
threshold1 (D1 a
x) = a
x
threshold1 (P1 a
x) = a
x

thresholdSet1 :: a -> Threshold a -> Threshold a
thresholdSet1 :: a -> Threshold a -> Threshold a
thresholdSet1 a
x (T1 a
_) = a -> Threshold a
forall a. a -> Threshold a
T1 a
x
thresholdSet1 a
x (D1 a
_) = a -> Threshold a
forall a. a -> Threshold a
D1 a
x
thresholdSet1 a
x (P1 a
_) = a -> Threshold a
forall a. a -> Threshold a
P1 a
x

data Duration a b = B a | T2 b | M a b deriving Duration a b -> Duration a b -> Bool
(Duration a b -> Duration a b -> Bool)
-> (Duration a b -> Duration a b -> Bool) -> Eq (Duration a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Duration a b -> Duration a b -> Bool
/= :: Duration a b -> Duration a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Duration a b -> Duration a b -> Bool
== :: Duration a b -> Duration a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Duration a b -> Duration a b -> Bool
Eq -- there is a not clearly documented possibility to specify also hours as duration, but it is rarely used and so is omitted.

instance Show (Duration Int Float) where
  show :: Duration Int Float -> String
show (B Int
n) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
n), String
" "]
  show (T2 Float
x) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
x) String
"t "
  show (M Int
n Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
n), String
":", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
x) String
" "]

type Duration2 = Duration Int Float

durationC :: Duration a b -> String
durationC :: Duration a b -> String
durationC (B a
_) = String
"B"
durationC (T2 b
_) = String
"T2"
durationC Duration a b
_ = String
"M"

duration1 :: Duration a b -> Maybe a
duration1 :: Duration a b -> Maybe a
duration1 (B a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
duration1 (M a
x b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
duration1 Duration a b
_ = Maybe a
forall a. Maybe a
Nothing

duration2 :: Duration a b -> Maybe b
duration2 :: Duration a b -> Maybe b
duration2 (T2 b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
duration2 (M a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
duration2 Duration a b
_ = Maybe b
forall a. Maybe a
Nothing

durationSet :: a -> b -> Int -> Duration a b
durationSet :: a -> b -> Int -> Duration a b
durationSet a
x b
y Int
n
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> Duration a b
forall a b. a -> Duration a b
B a
x
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = b -> Duration a b
forall a b. b -> Duration a b
T2 b
y
 | Bool
otherwise = a -> b -> Duration a b
forall a b. a -> b -> Duration a b
M a
x b
y

durationSet1d :: a -> Duration a b -> Duration a b
durationSet1d :: a -> Duration a b -> Duration a b
durationSet1d a
x (B a
_) = a -> Duration a b
forall a b. a -> Duration a b
B a
x
durationSet1d a
x (T2 b
y) = a -> b -> Duration a b
forall a b. a -> b -> Duration a b
M a
x b
y
durationSet1d a
x (M a
_ b
y) = a -> b -> Duration a b
forall a b. a -> b -> Duration a b
M a
x b
y

durationSet2d :: b -> Duration a b -> Duration a b
durationSet2d :: b -> Duration a b -> Duration a b
durationSet2d b
y (B a
x) = a -> b -> Duration a b
forall a b. a -> b -> Duration a b
M a
x b
y
durationSet2d b
y (T2 b
_) = b -> Duration a b
forall a b. b -> Duration a b
T2 b
y
durationSet2d b
y (M a
x b
_) = a -> b -> Duration a b
forall a b. a -> b -> Duration a b
M a
x b
y

-- | Analogical to 'TSpec' but without the first argument (it is unneeded here).
data STSpec a b = STs b | STm a b | STh a a b | SS a deriving STSpec a b -> STSpec a b -> Bool
(STSpec a b -> STSpec a b -> Bool)
-> (STSpec a b -> STSpec a b -> Bool) -> Eq (STSpec a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => STSpec a b -> STSpec a b -> Bool
/= :: STSpec a b -> STSpec a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => STSpec a b -> STSpec a b -> Bool
== :: STSpec a b -> STSpec a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => STSpec a b -> STSpec a b -> Bool
Eq

instance Show (STSpec Int Float) where 
  show :: STSpec Int Float -> String
show (STs Float
y) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
y) String
"t"
  show (STm Int
y Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y),String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"]
  show (STh Int
y1 Int
y2 Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y1),String
":",Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y2),String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"] -- is rarely used, but is technically possible.
  show (SS Int
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y),String
"s"]

type Above1TSpec = STSpec Int Float

instance Show (TimeSpec Above1TSpec NextTSpec) where
  show :: TimeSpec (STSpec Int Float) NextTSpec -> String
show (TS1 STSpec Int Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [STSpec Int Float -> String
forall a. Show a => a -> String
show STSpec Int Float
x, String
" "]
  show (TS2 STSpec Int Float
x [NextTSpec]
ys) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [STSpec Int Float -> String
forall a. Show a => a -> String
show STSpec Int Float
x,[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([NextTSpec] -> [String]) -> [NextTSpec] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NextTSpec -> String) -> [NextTSpec] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NextTSpec -> String
forall a. Show a => a -> String
show ([NextTSpec] -> String) -> [NextTSpec] -> String
forall a b. (a -> b) -> a -> b
$ [NextTSpec]
ys, String
" "]

type STSpecification1 = TimeSpec Above1TSpec NextTSpec

data STSpec2 a b = STs2 b | STm2 a b | STh2 a a b | SS2 a deriving STSpec2 a b -> STSpec2 a b -> Bool
(STSpec2 a b -> STSpec2 a b -> Bool)
-> (STSpec2 a b -> STSpec2 a b -> Bool) -> Eq (STSpec2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => STSpec2 a b -> STSpec2 a b -> Bool
/= :: STSpec2 a b -> STSpec2 a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => STSpec2 a b -> STSpec2 a b -> Bool
== :: STSpec2 a b -> STSpec2 a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => STSpec2 a b -> STSpec2 a b -> Bool
Eq

instance Show (STSpec2 Int Float) where 
  show :: STSpec2 Int Float -> String
show (STs2 Float
y) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
"t"
  show (STm2 Int
y Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show Int
y,String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"]
  show (STh2 Int
y1 Int
y2 Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show Int
y1,String
":",Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y2),String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"] -- is rarely used, but is technically possible.
  show (SS2 Int
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show Int
y,String
"s"]

type BelowTSpec = STSpec2 Int Float

instance Show (TimeSpec BelowTSpec NextTSpec) where
  show :: TimeSpec (STSpec2 Int Float) NextTSpec -> String
show (TS1 STSpec2 Int Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [STSpec2 Int Float -> String
forall a. Show a => a -> String
show STSpec2 Int Float
x, String
" "]
  show (TS2 STSpec2 Int Float
x [NextTSpec]
ys) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [STSpec2 Int Float -> String
forall a. Show a => a -> String
show STSpec2 Int Float
x,[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([NextTSpec] -> [String]) -> [NextTSpec] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NextTSpec -> String) -> [NextTSpec] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NextTSpec -> String
forall a. Show a => a -> String
show ([NextTSpec] -> String) -> [NextTSpec] -> String
forall a b. (a -> b) -> a -> b
$ [NextTSpec]
ys, String
" "]

type STSpecification2 = TimeSpec BelowTSpec NextTSpec

data AboveTSpec1 a b c = Z | A a b c deriving AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
(AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool)
-> (AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool)
-> Eq (AboveTSpec1 a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
/= :: AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
== :: AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
AboveTSpec1 a b c -> AboveTSpec1 a b c -> Bool
Eq

instance Show (AboveTSpec1 STSpecification1 Duration2 Threshold1) where
  show :: AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
-> String
show (A TimeSpec (STSpec Int Float) NextTSpec
x Duration Int Float
y Threshold Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [TimeSpec (STSpec Int Float) NextTSpec -> String
forall a. Show a => a -> String
show TimeSpec (STSpec Int Float) NextTSpec
x, Duration Int Float -> String
forall a. Show a => a -> String
show Duration Int Float
y, Threshold Float -> String
forall a. Show a => a -> String
show Threshold Float
z]
  show AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
_ = String
"0 "

type ATSpec = AboveTSpec1 STSpecification1 Duration2 Threshold1

aboveTSpec1 :: AboveTSpec1 a b c -> Maybe a
aboveTSpec1 :: AboveTSpec1 a b c -> Maybe a
aboveTSpec1 (A a
x b
_ c
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
aboveTSpec1 AboveTSpec1 a b c
_ = Maybe a
forall a. Maybe a
Nothing

aboveTSpec2 :: AboveTSpec1 a b c -> Maybe b
aboveTSpec2 :: AboveTSpec1 a b c -> Maybe b
aboveTSpec2 (A a
_ b
y c
_) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
aboveTSpec2 AboveTSpec1 a b c
_ = Maybe b
forall a. Maybe a
Nothing

aboveTSpec3 :: AboveTSpec1 a b c -> Maybe c
aboveTSpec3 :: AboveTSpec1 a b c -> Maybe c
aboveTSpec3 (A a
_ b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
aboveTSpec3 AboveTSpec1 a b c
_ = Maybe c
forall a. Maybe a
Nothing

aboveTSpecSet1 :: a -> b -> c -> AboveTSpec1 a b c
aboveTSpecSet1 :: a -> b -> c -> AboveTSpec1 a b c
aboveTSpecSet1 = a -> b -> c -> AboveTSpec1 a b c
forall a b c. a -> b -> c -> AboveTSpec1 a b c
A

aboveTSpecSet1a :: a -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet1a :: a -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet1a a
x (A a
_ b
y c
z) = a -> b -> c -> AboveTSpec1 a b c
forall a b c. a -> b -> c -> AboveTSpec1 a b c
A a
x b
y c
z
aboveTSpecSet1a a
_ AboveTSpec1 a b c
_ = AboveTSpec1 a b c
forall a b c. AboveTSpec1 a b c
Z

aboveTSpecSet2a :: b -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet2a :: b -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet2a b
y (A a
x b
_ c
z) = a -> b -> c -> AboveTSpec1 a b c
forall a b c. a -> b -> c -> AboveTSpec1 a b c
A a
x b
y c
z
aboveTSpecSet2a b
_ AboveTSpec1 a b c
_ = AboveTSpec1 a b c
forall a b c. AboveTSpec1 a b c
Z

aboveTSpecSet3a :: c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet3a :: c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet3a c
z (A a
x b
y c
_) = a -> b -> c -> AboveTSpec1 a b c
forall a b c. a -> b -> c -> AboveTSpec1 a b c
A a
x b
y c
z
aboveTSpecSet3a c
_ AboveTSpec1 a b c
_ = AboveTSpec1 a b c
forall a b c. AboveTSpec1 a b c
Z

data BelowTSpec1 a b c = Z2 | BL a b c deriving BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
(BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool)
-> (BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool)
-> Eq (BelowTSpec1 a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
/= :: BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
== :: BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
BelowTSpec1 a b c -> BelowTSpec1 a b c -> Bool
Eq

instance Show (BelowTSpec1 STSpecification2 Duration2 Threshold1) where
  show :: BelowTSpec1
  (TimeSpec (STSpec2 Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
-> String
show (BL TimeSpec (STSpec2 Int Float) NextTSpec
x Duration Int Float
y Threshold Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [TimeSpec (STSpec2 Int Float) NextTSpec -> String
forall a. Show a => a -> String
show TimeSpec (STSpec2 Int Float) NextTSpec
x, Duration Int Float -> String
forall a. Show a => a -> String
show Duration Int Float
y, Threshold Float -> String
forall a. Show a => a -> String
show Threshold Float
z]
  show BelowTSpec1
  (TimeSpec (STSpec2 Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
_ = String
""

type BTSpec = BelowTSpec1 STSpecification2 Duration2 Threshold1

belowTSpec1 :: BelowTSpec1 a b c -> Maybe a
belowTSpec1 :: BelowTSpec1 a b c -> Maybe a
belowTSpec1 (BL a
x b
_ c
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
belowTSpec1 BelowTSpec1 a b c
_ = Maybe a
forall a. Maybe a
Nothing

belowTSpec2 :: BelowTSpec1 a b c -> Maybe b
belowTSpec2 :: BelowTSpec1 a b c -> Maybe b
belowTSpec2 (BL a
_ b
y c
_) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
belowTSpec2 BelowTSpec1 a b c
_ = Maybe b
forall a. Maybe a
Nothing

belowTSpec3 :: BelowTSpec1 a b c -> Maybe c
belowTSpec3 :: BelowTSpec1 a b c -> Maybe c
belowTSpec3 (BL a
_ b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
belowTSpec3 BelowTSpec1 a b c
_ = Maybe c
forall a. Maybe a
Nothing

belowTSpecSet1 :: a -> b -> c -> BelowTSpec1 a b c
belowTSpecSet1 :: a -> b -> c -> BelowTSpec1 a b c
belowTSpecSet1 = a -> b -> c -> BelowTSpec1 a b c
forall a b c. a -> b -> c -> BelowTSpec1 a b c
BL

belowTSpecSet1b :: a -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet1b :: a -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet1b a
x (BL a
_ b
y c
z) = a -> b -> c -> BelowTSpec1 a b c
forall a b c. a -> b -> c -> BelowTSpec1 a b c
BL a
x b
y c
z
belowTSpecSet1b a
_ BelowTSpec1 a b c
_ = BelowTSpec1 a b c
forall a b c. BelowTSpec1 a b c
Z2

belowTSpecSet2b :: b -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet2b :: b -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet2b b
y (BL a
x b
_ c
z) = a -> b -> c -> BelowTSpec1 a b c
forall a b c. a -> b -> c -> BelowTSpec1 a b c
BL a
x b
y c
z
belowTSpecSet2b b
_ BelowTSpec1 a b c
_ = BelowTSpec1 a b c
forall a b c. BelowTSpec1 a b c
Z2

belowTSpecSet3b :: c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet3b :: c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet3b c
z (BL a
x b
y c
_) = a -> b -> c -> BelowTSpec1 a b c
forall a b c. a -> b -> c -> BelowTSpec1 a b c
BL a
x b
y c
z
belowTSpecSet3b c
_ BelowTSpec1 a b c
_ = BelowTSpec1 a b c
forall a b c. BelowTSpec1 a b c
Z2

data Silence a b c = SL2 a b | SL3 a b c deriving Silence a b c -> Silence a b c -> Bool
(Silence a b c -> Silence a b c -> Bool)
-> (Silence a b c -> Silence a b c -> Bool) -> Eq (Silence a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Silence a b c -> Silence a b c -> Bool
/= :: Silence a b c -> Silence a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Silence a b c -> Silence a b c -> Bool
== :: Silence a b c -> Silence a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Silence a b c -> Silence a b c -> Bool
Eq

instance Show (Silence LeftIntact ATSpec BTSpec) where 
  show :: Silence
  LeftIntact
  (AboveTSpec1
     (TimeSpec (STSpec Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
  (BelowTSpec1
     (TimeSpec (STSpec2 Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
-> String
show (SL2 LeftIntact
x AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"silence ", LeftIntact -> String
forall a. Show a => a -> String
show LeftIntact
x, AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
-> String
forall a. Show a => a -> String
show AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
y]
  show (SL3 LeftIntact
x AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
y BelowTSpec1
  (TimeSpec (STSpec2 Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"silence ", LeftIntact -> String
forall a. Show a => a -> String
show LeftIntact
x, AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
-> String
forall a. Show a => a -> String
show AboveTSpec1
  (TimeSpec (STSpec Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
y, BelowTSpec1
  (TimeSpec (STSpec2 Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
-> String
forall a. Show a => a -> String
show BelowTSpec1
  (TimeSpec (STSpec2 Int Float) NextTSpec)
  (Duration Int Float)
  (Threshold Float)
z]

type Silence3 = Silence LeftIntact ATSpec BTSpec

silenceC :: Silence a b c -> String
silenceC :: Silence a b c -> String
silenceC (SL2 a
_ b
_) = String
"SL2"
silenceC (SL3 a
_ b
_ c
_) = String
"SL3"

silence1 :: Silence a b c -> a
silence1 :: Silence a b c -> a
silence1 (SL2 a
x b
_) = a
x
silence1 (SL3 a
x b
_ c
_) = a
x

silence2 :: Silence a b c -> b
silence2 :: Silence a b c -> b
silence2 (SL2 a
_ b
y) = b
y
silence2 (SL3 a
_ b
y c
_) = b
y

silence3 :: Silence a b c -> Maybe c
silence3 :: Silence a b c -> Maybe c
silence3 (SL3 a
_ b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
silence3 Silence a b c
_ = Maybe c
forall a. Maybe a
Nothing

silenceSet1 :: a -> Silence a b c -> Silence a b c
silenceSet1 :: a -> Silence a b c -> Silence a b c
silenceSet1 a
x (SL2 a
_ b
y) = a -> b -> Silence a b c
forall a b c. a -> b -> Silence a b c
SL2 a
x b
y
silenceSet1 a
x (SL3 a
_ b
y c
z) = a -> b -> c -> Silence a b c
forall a b c. a -> b -> c -> Silence a b c
SL3 a
x b
y c
z

silenceSet2 :: b -> Silence a b c -> Silence a b c
silenceSet2 :: b -> Silence a b c -> Silence a b c
silenceSet2 b
y (SL2 a
x b
_) = a -> b -> Silence a b c
forall a b c. a -> b -> Silence a b c
SL2 a
x b
y
silenceSet2 b
y (SL3 a
x b
_ c
z) = a -> b -> c -> Silence a b c
forall a b c. a -> b -> c -> Silence a b c
SL3 a
x b
y c
z

silenceSet3 :: c -> Silence a b c -> Silence a b c
silenceSet3 :: c -> Silence a b c -> Silence a b c
silenceSet3 c
z (SL2 a
x b
y) = a -> b -> c -> Silence a b c
forall a b c. a -> b -> c -> Silence a b c
SL3 a
x b
y c
z
silenceSet3 c
z (SL3 a
x b
y c
_) = a -> b -> c -> Silence a b c
forall a b c. a -> b -> c -> Silence a b c
SL3 a
x b
y c
z

showSLQ :: Silence3 -> [String]
showSLQ :: Silence
  LeftIntact
  (AboveTSpec1
     (TimeSpec (STSpec Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
  (BelowTSpec1
     (TimeSpec (STSpec2 Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
-> [String]
showSLQ = String -> [String]
words (String -> [String])
-> (Silence
      LeftIntact
      (AboveTSpec1
         (TimeSpec (STSpec Int Float) NextTSpec)
         (Duration Int Float)
         (Threshold Float))
      (BelowTSpec1
         (TimeSpec (STSpec2 Int Float) NextTSpec)
         (Duration Int Float)
         (Threshold Float))
    -> String)
-> Silence
     LeftIntact
     (AboveTSpec1
        (TimeSpec (STSpec Int Float) NextTSpec)
        (Duration Int Float)
        (Threshold Float))
     (BelowTSpec1
        (TimeSpec (STSpec2 Int Float) NextTSpec)
        (Duration Int Float)
        (Threshold Float))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Silence
  LeftIntact
  (AboveTSpec1
     (TimeSpec (STSpec Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
  (BelowTSpec1
     (TimeSpec (STSpec2 Int Float) NextTSpec)
     (Duration Int Float)
     (Threshold Float))
-> String
forall a. Show a => a -> String
show