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

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

module DobutokO.Sound.Effects.Rate 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.Specs (Freq1)

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

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

instance Show RateTL where
  show :: RateTL -> String
show RateTL
Q = String
"-q "
  show RateTL
_ = String
"-l "

data RateTH = M | H | V deriving RateTH -> RateTH -> Bool
(RateTH -> RateTH -> Bool)
-> (RateTH -> RateTH -> Bool) -> Eq RateTH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RateTH -> RateTH -> Bool
$c/= :: RateTH -> RateTH -> Bool
== :: RateTH -> RateTH -> Bool
$c== :: RateTH -> RateTH -> Bool
Eq

instance Show RateTH where
  show :: RateTH -> String
show RateTH
M = String
"-m "
  show RateTH
H = String
"-h "
  show RateTH
_ = String
"-v "

data ROpt1 = N1 | M1 | I1 | L1 deriving ROpt1 -> ROpt1 -> Bool
(ROpt1 -> ROpt1 -> Bool) -> (ROpt1 -> ROpt1 -> Bool) -> Eq ROpt1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ROpt1 -> ROpt1 -> Bool
$c/= :: ROpt1 -> ROpt1 -> Bool
== :: ROpt1 -> ROpt1 -> Bool
$c== :: ROpt1 -> ROpt1 -> Bool
Eq

instance Show ROpt1 where
  show :: ROpt1 -> String
show ROpt1
M1 = String
"-M "
  show ROpt1
I1 = String
"-I "
  show ROpt1
L1 = String
"-L "
  show ROpt1
_ = String
""

data ROpt2 = N2 | S2 deriving ROpt2 -> ROpt2 -> Bool
(ROpt2 -> ROpt2 -> Bool) -> (ROpt2 -> ROpt2 -> Bool) -> Eq ROpt2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ROpt2 -> ROpt2 -> Bool
$c/= :: ROpt2 -> ROpt2 -> Bool
== :: ROpt2 -> ROpt2 -> Bool
$c== :: ROpt2 -> ROpt2 -> Bool
Eq

instance Show ROpt2 where
  show :: ROpt2 -> String
show ROpt2
S2 = String
"-s "
  show ROpt2
_ = String
""

data ROpt3 = N3 | A3 deriving ROpt3 -> ROpt3 -> Bool
(ROpt3 -> ROpt3 -> Bool) -> (ROpt3 -> ROpt3 -> Bool) -> Eq ROpt3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ROpt3 -> ROpt3 -> Bool
$c/= :: ROpt3 -> ROpt3 -> Bool
== :: ROpt3 -> ROpt3 -> Bool
$c== :: ROpt3 -> ROpt3 -> Bool
Eq

instance Show ROpt3 where
  show :: ROpt3 -> String
show ROpt3
A3 = String
"-a "
  show ROpt3
_ = String
""

data Ropt4 a = N4 | B a deriving Ropt4 a -> Ropt4 a -> Bool
(Ropt4 a -> Ropt4 a -> Bool)
-> (Ropt4 a -> Ropt4 a -> Bool) -> Eq (Ropt4 a)
forall a. Eq a => Ropt4 a -> Ropt4 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ropt4 a -> Ropt4 a -> Bool
$c/= :: forall a. Eq a => Ropt4 a -> Ropt4 a -> Bool
== :: Ropt4 a -> Ropt4 a -> Bool
$c== :: forall a. Eq a => Ropt4 a -> Ropt4 a -> Bool
Eq

instance Show (Ropt4 Float) where
  show :: Ropt4 Float -> String
show (B Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-b ", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
99.7 (Float -> Float
forall a. Num a => a -> a
abs Float
x)) Float
74.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then String
"74.0" else 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.7 (Float -> Float
forall a. Num a => a -> a
abs Float
x)) String
" "]
  show Ropt4 Float
_ = String
""

type ROpt4 = Ropt4 Float

rOpt4C :: Ropt4 a -> String
rOpt4C :: Ropt4 a -> String
rOpt4C (B a
_) = String
"B"
rOpt4C Ropt4 a
_ = String
"N4"

rOpt41 :: Ropt4 a -> Maybe a
rOpt41 :: Ropt4 a -> Maybe a
rOpt41 (B a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
rOpt41 Ropt4 a
_ = Maybe a
forall a. Maybe a
Nothing

rOpt4Set1 :: a -> Ropt4 a
rOpt4Set1 :: a -> Ropt4 a
rOpt4Set1 = a -> Ropt4 a
forall a. a -> Ropt4 a
B

data Ropt5 a = N5 | P a deriving Ropt5 a -> Ropt5 a -> Bool
(Ropt5 a -> Ropt5 a -> Bool)
-> (Ropt5 a -> Ropt5 a -> Bool) -> Eq (Ropt5 a)
forall a. Eq a => Ropt5 a -> Ropt5 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ropt5 a -> Ropt5 a -> Bool
$c/= :: forall a. Eq a => Ropt5 a -> Ropt5 a -> Bool
== :: Ropt5 a -> Ropt5 a -> Bool
$c== :: forall a. Eq a => Ropt5 a -> Ropt5 a -> Bool
Eq

instance Show (Ropt5 Float) where
  show :: Ropt5 Float -> String
show (P Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-p ", 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
forall a. Num a => a -> a
abs Float
x)) String
" "]
  show Ropt5 Float
_ = String
""

type ROpt5 = Ropt5 Float

rOpt5C :: Ropt5 a -> String
rOpt5C :: Ropt5 a -> String
rOpt5C (P a
_) = String
"P"
rOpt5C Ropt5 a
_ = String
"N5"

rOpt51 :: Ropt5 a -> Maybe a
rOpt51 :: Ropt5 a -> Maybe a
rOpt51 (P a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
rOpt51 Ropt5 a
_ = Maybe a
forall a. Maybe a
Nothing

rOpt5Set1 :: a -> Ropt5 a
rOpt5Set1 :: a -> Ropt5 a
rOpt5Set1 = a -> Ropt5 a
forall a. a -> Ropt5 a
P

data RateL a b = RL a b deriving RateL a b -> RateL a b -> Bool
(RateL a b -> RateL a b -> Bool)
-> (RateL a b -> RateL a b -> Bool) -> Eq (RateL a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => RateL a b -> RateL a b -> Bool
/= :: RateL a b -> RateL a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => RateL a b -> RateL a b -> Bool
== :: RateL a b -> RateL a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => RateL a b -> RateL a b -> Bool
Eq

instance Show (RateL RateTL Freq1) where
  show :: RateL RateTL Freq1 -> String
show (RL RateTL
x Freq1
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"rate ", RateTL -> String
forall a. Show a => a -> String
show RateTL
x, Freq1 -> String
forall a. Show a => a -> String
show Freq1
y]

type RateLow = RateL RateTL Freq1

rateL1 :: RateL a b -> a
rateL1 :: RateL a b -> a
rateL1 (RL a
x b
_) = a
x

rateL2 :: RateL a b -> b
rateL2 :: RateL a b -> b
rateL2 (RL a
_ b
y) = b
y

rateLSet1 :: a -> RateL a b -> RateL a b
rateLSet1 :: a -> RateL a b -> RateL a b
rateLSet1 a
x (RL a
_ b
y) = a -> b -> RateL a b
forall a b. a -> b -> RateL a b
RL a
x b
y

rateLSet2 :: b -> RateL a b -> RateL a b
rateLSet2 :: b -> RateL a b -> RateL a b
rateLSet2 b
y (RL a
x b
_) = a -> b -> RateL a b
forall a b. a -> b -> RateL a b
RL a
x b
y

showRLQ :: RateLow -> [String]
showRLQ :: RateL RateTL Freq1 -> [String]
showRLQ = String -> [String]
words (String -> [String])
-> (RateL RateTL Freq1 -> String) -> RateL RateTL Freq1 -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RateL RateTL Freq1 -> String
forall a. Show a => a -> String
show 

data RateH a b1 b2 b3 b4 b5 c = RH a b1 b2 b3 b4 b5 c deriving RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
(RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool)
-> (RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool)
-> Eq (RateH a b1 b2 b3 b4 b5 c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b1 b2 b3 b4 b5 c.
(Eq a, Eq b1, Eq b2, Eq b3, Eq b4, Eq b5, Eq c) =>
RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
/= :: RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
$c/= :: forall a b1 b2 b3 b4 b5 c.
(Eq a, Eq b1, Eq b2, Eq b3, Eq b4, Eq b5, Eq c) =>
RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
== :: RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
$c== :: forall a b1 b2 b3 b4 b5 c.
(Eq a, Eq b1, Eq b2, Eq b3, Eq b4, Eq b5, Eq c) =>
RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c -> Bool
Eq

instance Show (RateH RateTH ROpt1 ROpt2 ROpt3 ROpt4 ROpt5 Freq1) where
  show :: RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> String
show (RH RateTH
x ROpt1
y1 ROpt2
y2 ROpt3
y3 Ropt4 Float
y4 Ropt5 Float
y5 Freq1
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"rate ", RateTH -> String
forall a. Show a => a -> String
show RateTH
x, ROpt1 -> String
forall a. Show a => a -> String
show ROpt1
y1, ROpt2 -> String
forall a. Show a => a -> String
show ROpt2
y2, ROpt3 -> String
forall a. Show a => a -> String
show ROpt3
y3, Ropt4 Float -> String
forall a. Show a => a -> String
show Ropt4 Float
y4, Ropt5 Float -> String
forall a. Show a => a -> String
show Ropt5 Float
y5, Freq1 -> String
forall a. Show a => a -> String
show Freq1
z]

type RateHigh = RateH RateTH ROpt1 ROpt2 ROpt3 ROpt4 ROpt5 Freq1

rateH1 :: RateH a b1 b2 b3 b4 b5 c -> a
rateH1 :: RateH a b1 b2 b3 b4 b5 c -> a
rateH1 (RH a
x b1
_ b2
_ b3
_ b4
_ b5
_ c
_) = a
x

rateH21 :: RateH a b1 b2 b3 b4 b5 c -> b1
rateH21 :: RateH a b1 b2 b3 b4 b5 c -> b1
rateH21 (RH a
_ b1
y1 b2
_ b3
_ b4
_ b5
_ c
_) = b1
y1

rateH22 :: RateH a b1 b2 b3 b4 b5 c -> b2
rateH22 :: RateH a b1 b2 b3 b4 b5 c -> b2
rateH22 (RH a
_ b1
_ b2
y2 b3
_ b4
_ b5
_ c
_) = b2
y2

rateH23 :: RateH a b1 b2 b3 b4 b5 c -> b3
rateH23 :: RateH a b1 b2 b3 b4 b5 c -> b3
rateH23 (RH a
_ b1
_ b2
_ b3
y3 b4
_ b5
_ c
_) = b3
y3

rateH24 :: RateH a b1 b2 b3 b4 b5 c -> b4
rateH24 :: RateH a b1 b2 b3 b4 b5 c -> b4
rateH24 (RH a
_ b1
_ b2
_ b3
_ b4
y4 b5
_ c
_) = b4
y4

rateH25 :: RateH a b1 b2 b3 b4 b5 c -> b5
rateH25 :: RateH a b1 b2 b3 b4 b5 c -> b5
rateH25 (RH a
_ b1
_ b2
_ b3
_ b4
_ b5
y5 c
_) = b5
y5

rateH3 :: RateH a b1 b2 b3 b4 b5 c -> c
rateH3 :: RateH a b1 b2 b3 b4 b5 c -> c
rateH3 (RH a
_ b1
_ b2
_ b3
_ b4
_ b5
_ c
z) = c
z

rateHSet1 :: a -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet1 :: a -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet1 a
x (RH a
_ b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet21 :: b1 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet21 :: b1 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet21 b1
y1 (RH a
x b1
_ b2
y2 b3
y3 b4
y4 b5
y5 c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet22 :: b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet22 :: b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet22 b2
y2 (RH a
x b1
y1 b2
_ b3
y3 b4
y4 b5
y5 c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet23 :: b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet23 :: b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet23 b3
y3 (RH a
x b1
y1 b2
y2 b3
_ b4
y4 b5
y5 c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet24 :: b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet24 :: b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet24 b4
y4 (RH a
x b1
y1 b2
y2 b3
y3 b4
_ b5
y5 c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet25 :: b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet25 :: b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet25 b5
y5 (RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
_ c
z) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

rateHSet3 :: c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet3 :: c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c
rateHSet3 c
z (RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
_) = a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
forall a b1 b2 b3 b4 b5 c.
a -> b1 -> b2 -> b3 -> b4 -> b5 -> c -> RateH a b1 b2 b3 b4 b5 c
RH a
x b1
y1 b2
y2 b3
y3 b4
y4 b5
y5 c
z

showRHQ :: RateHigh -> [String]
showRHQ :: RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> [String]
showRHQ = String -> [String]
words (String -> [String])
-> (RateH
      RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
    -> String)
-> RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> String
forall a. Show a => a -> String
show 

data Rate2 a b = LR a | HR b deriving Rate2 a b -> Rate2 a b -> Bool
(Rate2 a b -> Rate2 a b -> Bool)
-> (Rate2 a b -> Rate2 a b -> Bool) -> Eq (Rate2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Rate2 a b -> Rate2 a b -> Bool
/= :: Rate2 a b -> Rate2 a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Rate2 a b -> Rate2 a b -> Bool
== :: Rate2 a b -> Rate2 a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Rate2 a b -> Rate2 a b -> Bool
Eq

instance Show (Rate2 RateLow RateHigh) where 
  show :: Rate2
  (RateL RateTL Freq1)
  (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
-> String
show (LR RateL RateTL Freq1
x) = RateL RateTL Freq1 -> String
forall a. Show a => a -> String
show RateL RateTL Freq1
x
  show (HR RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
x) = RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> String
forall a. Show a => a -> String
show RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
x

type Rate = Rate2 RateLow RateHigh

rate2C :: Rate2 a b -> String
rate2C :: Rate2 a b -> String
rate2C (LR a
_) = String
"LR"
rate2C Rate2 a b
_ = String
"HR"

rate21 :: Rate2 a b -> Maybe a
rate21 :: Rate2 a b -> Maybe a
rate21 (LR a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
rate21 Rate2 a b
_ = Maybe a
forall a. Maybe a
Nothing

rate22 :: Rate2 a b -> Maybe b
rate22 :: Rate2 a b -> Maybe b
rate22 (HR b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
rate22 Rate2 a b
_ = Maybe b
forall a. Maybe a
Nothing

rate2Set1 :: RateLow -> Rate
rate2Set1 :: RateL RateTL Freq1
-> Rate2
     (RateL RateTL Freq1)
     (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
rate2Set1 = RateL RateTL Freq1
-> Rate2
     (RateL RateTL Freq1)
     (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
forall a b. a -> Rate2 a b
LR

rate2Set2 :: RateHigh -> Rate
rate2Set2 :: RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> Rate2
     (RateL RateTL Freq1)
     (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
rate2Set2 = RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1
-> Rate2
     (RateL RateTL Freq1)
     (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
forall a b. b -> Rate2 a b
HR

showRQ :: Rate -> [String]
showRQ :: Rate2
  (RateL RateTL Freq1)
  (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
-> [String]
showRQ = String -> [String]
words (String -> [String])
-> (Rate2
      (RateL RateTL Freq1)
      (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
    -> String)
-> Rate2
     (RateL RateTL Freq1)
     (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate2
  (RateL RateTL Freq1)
  (RateH RateTH ROpt1 ROpt2 ROpt3 (Ropt4 Float) (Ropt5 Float) Freq1)
-> String
forall a. Show a => a -> String
show