-- |
-- Module      :  DobutokO.Sound.Effects.Segment
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the \"pitch\" and / or \"tempo\" SoX effects. 
-- 

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

module DobutokO.Sound.Effects.Segment 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)

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

data Segment a = E0 | S1 a | S2 a a | S3 a a a deriving Segment a -> Segment a -> Bool
(Segment a -> Segment a -> Bool)
-> (Segment a -> Segment a -> Bool) -> Eq (Segment a)
forall a. Eq a => Segment a -> Segment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment a -> Segment a -> Bool
$c/= :: forall a. Eq a => Segment a -> Segment a -> Bool
== :: Segment a -> Segment a -> Bool
$c== :: forall a. Eq a => Segment a -> Segment a -> Bool
Eq

instance Show (Segment Float) where
  show :: Segment Float -> String
show (Segment Float
E0) = String
""
  show (S1 Float
x) 
    | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
10.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
120.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" "
    | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Segment.show: Not defined for the value. It must be in [10.0..120.0]. "
  show (S2 Float
x Float
y) 
    | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
10.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
120.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
30.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
" "]
    | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Segment.show: Not defined for the values. The first one must be in [10.0..120.0] and the second one -- in [0.0..30.0]. "
  show (S3 Float
x Float
y Float
z) 
    | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
10.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
120.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
30.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
z Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
z Float
30.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = 
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
z String
" "]
    | Bool
otherwise = 
       ShowS
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Segment.show: Not defined for the values. The first one must be in [10.0..120.0], the second and the third ones -- in [0.0..30.0] . "

type Segm = Segment Float

segmentC :: Segment a -> String
segmentC :: Segment a -> String
segmentC Segment a
E0 = String
"E0"
segmentC (S1 a
_) = String
"S1"
segmentC (S2 a
_ a
_) = String
"S2"
segmentC (S3 a
_ a
_ a
_) = String
"S3"

segment1 :: Segment a -> Maybe a
segment1 :: Segment a -> Maybe a
segment1 (S1 a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
segment1 (S2 a
x a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
segment1 (S3 a
x a
_ a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
segment1 Segment a
_ = Maybe a
forall a. Maybe a
Nothing

segment2 :: Segment a -> Maybe a
segment2 :: Segment a -> Maybe a
segment2 (S2 a
_ a
y) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
segment2 (S3 a
_ a
y a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
segment2 Segment a
_ = Maybe a
forall a. Maybe a
Nothing

segment3 :: Segment a -> Maybe a
segment3 :: Segment a -> Maybe a
segment3 (S3 a
_ a
_ a
z) = a -> Maybe a
forall a. a -> Maybe a
Just a
z
segment3 Segment a
_ = Maybe a
forall a. Maybe a
Nothing

segmentSet1 :: a -> Segment a -> Segment a
segmentSet1 :: a -> Segment a -> Segment a
segmentSet1 a
x (S2 a
_ a
y) = a -> a -> Segment a
forall a. a -> a -> Segment a
S2 a
x a
y
segmentSet1 a
x (S3 a
_ a
y a
z) = a -> a -> a -> Segment a
forall a. a -> a -> a -> Segment a
S3 a
x a
y a
z
segmentSet1 a
x Segment a
_ = a -> Segment a
forall a. a -> Segment a
S1 a
x

segmentSet2 :: a -> a -> Segment a -> Segment a
segmentSet2 :: a -> a -> Segment a -> Segment a
segmentSet2 a
x a
y (S3 a
_ a
_ a
z) = a -> a -> a -> Segment a
forall a. a -> a -> a -> Segment a
S3 a
x a
y a
z
segmentSet2 a
x a
y Segment a
_ = a -> a -> Segment a
forall a. a -> a -> Segment a
S2 a
x a
y

segmentSet3 :: a -> a -> a -> Segment a
segmentSet3 :: a -> a -> a -> Segment a
segmentSet3 = a -> a -> a -> Segment a
forall a. a -> a -> a -> Segment a
S3

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

instance Show Qdash where
  show :: Qdash -> String
show Qdash
E = String
""
  show Qdash
Q = String
"-q "