-- |
-- Module      :  Composition.Sound.Presentation
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- This module contains different representations for the data.
-- Is rewritten from the dobutokO4 package.

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK show-extensions #-}

module Composition.Sound.Presentation (
  -- * Sound repesentations
  SoundI (..)
  , SoundFN (..)
  , SoundT (..)
  -- * Sound time intervals representations
  , Timity (..)
  , Timity1 (..)
  , IntervalTim (..)
  , IntervalTimI (..)
  , IntervalG (..)
  , IntervalMG (..)
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import Data.Bifunctor 
#endif
#endif
import Numeric (showFFloat)
import Composition.Sound.Functional.Basics
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
import Data.Semigroup
#endif
#endif
import Data.Monoid

-- | An 'Int' parameter is an index of the 'SoundI' sound file in the sorted in the ascending order 'V.Vector' of them (the corresponding files or their 
-- names) representing the whole composition.
data SoundI = Si Int Float Float OvertonesO | SAi Int Float Float Float OvertonesO | SAbi Int Float Float Float OvertonesO
  deriving SoundI -> SoundI -> Bool
(SoundI -> SoundI -> Bool)
-> (SoundI -> SoundI -> Bool) -> Eq SoundI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SoundI -> SoundI -> Bool
$c/= :: SoundI -> SoundI -> Bool
== :: SoundI -> SoundI -> Bool
$c== :: SoundI -> SoundI -> Bool
Eq

----------------------------------------------------------------------------------

-- | An 'FilePath' parameter is a name of the sound file in the current directory with the filetype (supported by SoX) being given by 'String' representing 
-- the whole composition.
data SoundFN = Sn FilePath String Float Float | SAn FilePath String Float Float Float | SAbn FilePath String Float Float Float
  deriving SoundFN -> SoundFN -> Bool
(SoundFN -> SoundFN -> Bool)
-> (SoundFN -> SoundFN -> Bool) -> Eq SoundFN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SoundFN -> SoundFN -> Bool
$c/= :: SoundFN -> SoundFN -> Bool
== :: SoundFN -> SoundFN -> Bool
$c== :: SoundFN -> SoundFN -> Bool
Eq

----------------------------------------------------------------------------------

-- | The first 'Float' parameter is a time moment (starting from 0) of the playing the sound being represented by 'OvertonesO', the second one is its 
-- duration. The third one is its maximum amplitude by an absolute value. The fourth one is the minimum duration that can provide a needed human 
-- feeling of perception (some impression) for the sound. The further one(s) is(are) some adjustment(s) parameter(s).
data SoundT = StO Float Float Float Float OvertonesO | SAtO Float Float Float Float Float OvertonesO | 
  SAbtO Float Float Float Float Float OvertonesO deriving SoundT -> SoundT -> Bool
(SoundT -> SoundT -> Bool)
-> (SoundT -> SoundT -> Bool) -> Eq SoundT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SoundT -> SoundT -> Bool
$c/= :: SoundT -> SoundT -> Bool
== :: SoundT -> SoundT -> Bool
$c== :: SoundT -> SoundT -> Bool
Eq

----------------------------------------------------------------------------------

-- | The first 'Float' parameter is a time moment (starting from 0) of the playing the sound, the second one is its duration in seconds (with a negative 
-- values corresponding to the pause duration --- the silent \"sound\"), the third one is the minimum duration that can provide a needed human 
-- feeling of perception (some impression) for the sound.
data Timity = Time Float Float Float deriving Timity -> Timity -> Bool
(Timity -> Timity -> Bool)
-> (Timity -> Timity -> Bool) -> Eq Timity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timity -> Timity -> Bool
$c/= :: Timity -> Timity -> Bool
== :: Timity -> Timity -> Bool
$c== :: Timity -> Timity -> Bool
Eq

instance Ord Timity where 
  compare :: Timity -> Timity -> Ordering
compare (Time Float
t01 Float
t11 Float
t21) (Time Float
t02 Float
t12 Float
t22) 
    | Float
t01 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
t02 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
t01 Float
t02
    | Float -> Float
forall a. Num a => a -> a
abs Float
t11 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Float
forall a. Num a => a -> a
abs Float
t12 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
t11) (Float -> Float
forall a. Num a => a -> a
abs Float
t12)
    | Bool
otherwise = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
t22) (Float -> Float
forall a. Num a => a -> a
abs Float
t21)

instance Show Timity where
  show :: Timity -> String
show (Time Float
t0 Float
t1 Float
t2) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t0 String
":(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t1 String
"):(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t2 String
")"

-- | The first 'Float' parameter is a time moment (starting from 0) of the playing the sound, the second one is its duration in seconds (with a negative 
-- values corresponding to the pause duration --- the silent \"sound\"), the third one is a parameter to specify more complex behaviour for the sound. 
data Timity1 a = Time1 Float Float a 

instance (Eq a) => Eq (Timity1 a) where
  == :: Timity1 a -> Timity1 a -> Bool
(==) (Time1 Float
x1 Float
x2 a
a0) (Time1 Float
x3 Float
x4 a
a1)
    | a
a0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a1 = Bool
False
    | Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
x3 = Bool
False
    | Bool
otherwise = Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x4

instance (Ord a) => Ord (Timity1 a) where 
  compare :: Timity1 a -> Timity1 a -> Ordering
compare (Time1 Float
t01 Float
t11 a
a0) (Time1 Float
t02 Float
t12 a
a1) 
    | Float
t01 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
t02 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
t01 Float
t02
    | Float -> Float
forall a. Num a => a -> a
abs Float
t11 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Float
forall a. Num a => a -> a
abs Float
t12 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
t11) (Float -> Float
forall a. Num a => a -> a
abs Float
t12)
    | Bool
otherwise = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a0 a
a1

instance (Show a) => Show (Timity1 a) where
  show :: Timity1 a -> String
show (Time1 Float
t0 Float
t1 a
a1) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t0 String
":(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t1 String
"):(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"  

instance Functor Timity1 where
  fmap :: (a -> b) -> Timity1 a -> Timity1 b
fmap a -> b
f (Time1 Float
t1 Float
t2 a
a0) = Float -> Float -> b -> Timity1 b
forall a. Float -> Float -> a -> Timity1 a
Time1 Float
t1 Float
t2 (a -> b
f a
a0)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
-- | Since base-4.9.0.0. Idempotent semigroup (band) (x <> x == x) if @Semigroup a@ is idempotent (is a band).
instance (Semigroup a) => Semigroup (Timity1 a) where
  <> :: Timity1 a -> Timity1 a -> Timity1 a
(<>) (Time1 Float
t01 Float
t11 a
a0) (Time1 Float
t02 Float
t12 a
a1) = Float -> Float -> a -> Timity1 a
forall a. Float -> Float -> a -> Timity1 a
Time1 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
t01 Float
t02) ((Float -> Float
forall a. Num a => a -> a
signum (Float
t11 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t12)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float
t01 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float -> Float
forall a. Num a => a -> a
abs Float
t11)) (Float
t02 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float -> Float
forall a. Num a => a -> a
abs Float
t12)) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
t01 Float
t02)) 
          (a
a0 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a1)
#endif
#endif

-- | 'Float' interval representation with no order of the arguments preserved.
data IntervalTim = Empty | I Float Float | UniversalI

instance Eq IntervalTim where
  == :: IntervalTim -> IntervalTim -> Bool
(==) (I Float
x1 Float
x2) (I Float
y1 Float
y2) 
    | Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
y1 = if Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y2 then Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y1 else Bool
False
    | Bool
otherwise = Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y2
  (==) IntervalTim
UniversalI IntervalTim
UniversalI = Bool
True
  (==) IntervalTim
Empty IntervalTim
Empty = Bool
True
  (==) IntervalTim
_ IntervalTim
_ = Bool
False

instance Ord IntervalTim where 
  compare :: IntervalTim -> IntervalTim -> Ordering
compare (I Float
x01 Float
x02) (I Float
x11 Float
x12) 
    | Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x11 Float
x12)
    | Bool
otherwise = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12)
  compare IntervalTim
UniversalI IntervalTim
UniversalI = Ordering
EQ
  compare IntervalTim
Empty IntervalTim
Empty = Ordering
EQ
  compare IntervalTim
_ IntervalTim
UniversalI = Ordering
LT
  compare IntervalTim
_ IntervalTim
Empty = Ordering
GT
  compare IntervalTim
UniversalI IntervalTim
_ = Ordering
GT
  compare IntervalTim
_ IntervalTim
_ = Ordering
LT

instance Show IntervalTim where
  show :: IntervalTim -> String
show IntervalTim
Empty = String
"()"
  show (I Float
x1 Float
x2) 
    | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x1 String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x2 String
"]"
    | Bool
otherwise = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x2 String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x1 String
"]"
  show IntervalTim
UniversalI = String
"(-Infinity..+Infinity)"

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
-- | Since base-4.9.0.0. Idempotent semigroup (x <> x == x) -- band. 
instance Semigroup IntervalTim where
  <> :: IntervalTim -> IntervalTim -> IntervalTim
(<>) (I Float
x01 Float
x02) (I Float
x11 Float
x12) = Float -> Float -> IntervalTim
I ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float
x01,Float
x02,Float
x11,Float
x12]) ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float
x01,Float
x02,Float
x11,Float
x12])
  (<>) IntervalTim
Empty IntervalTim
x = IntervalTim
x
  (<>) IntervalTim
x IntervalTim
Empty = IntervalTim
x
  (<>) IntervalTim
_ IntervalTim
_ = IntervalTim
UniversalI
#endif
#endif

instance Monoid IntervalTim where
  mempty :: IntervalTim
mempty = IntervalTim
Empty
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__<=802
/* code that applies only to GHC 8.2.* and lower versions */
  mappend Empty x = x
  mappend x Empty = x
  mappend (I x01 x02) (I x11 x12) = I (minimum [x01,x02,x11,x12]) (maximum [x01,x02,x11,x12])
  mappend _ _ = UniversalI
#endif
#endif
  
-- | Another 'Float' interval representation with no order of the arguments preserved. Since base-4.9.0.0 has different instance of 'Semigroup' 
-- than 'IntervalTim'.
data IntervalTimI = Empty2 | II Float Float | UniversalII
  
instance Eq IntervalTimI where
  == :: IntervalTimI -> IntervalTimI -> Bool
(==) (II Float
x1 Float
x2) (II Float
y1 Float
y2) 
    | Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
y1 = if Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y2 then Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y1 else Bool
False
    | Bool
otherwise = Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y2
  (==) IntervalTimI
Empty2 IntervalTimI
Empty2 = Bool
True
  (==) IntervalTimI
UniversalII IntervalTimI
UniversalII = Bool
True
  (==) IntervalTimI
_ IntervalTimI
_ = Bool
False

instance Ord IntervalTimI where 
  compare :: IntervalTimI -> IntervalTimI -> Ordering
compare (II Float
x01 Float
x02) (II Float
x11 Float
x12) 
    | Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x11 Float
x12)
    | Bool
otherwise = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12)
  compare IntervalTimI
Empty2 IntervalTimI
Empty2 = Ordering
EQ
  compare IntervalTimI
Empty2 IntervalTimI
_ = Ordering
LT
  compare IntervalTimI
UniversalII IntervalTimI
UniversalII = Ordering
EQ
  compare IntervalTimI
UniversalII IntervalTimI
_ = Ordering
GT
  compare IntervalTimI
_ IntervalTimI
Empty2 = Ordering
GT
  compare IntervalTimI
_ IntervalTimI
_ = Ordering
LT

instance Show IntervalTimI where
  show :: IntervalTimI -> String
show IntervalTimI
Empty2 = String
"()"
  show (II Float
x1 Float
x2) 
    | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x1 String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x2 String
"]"
    | Bool
otherwise = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x2 String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x1 String
"]"
  show IntervalTimI
UniversalII = String
"(-Infinity..+Infinity)"

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
-- | Since base-4.9.0.0. Idempotent semigroup (x <> x == x) -- band. (<>) can be understood as an intersection of the sets.
instance Semigroup IntervalTimI where
  <> :: IntervalTimI -> IntervalTimI -> IntervalTimI
(<>) IntervalTimI
Empty2 IntervalTimI
x = IntervalTimI
Empty2
  (<>) IntervalTimI
x IntervalTimI
Empty2 = IntervalTimI
Empty2
  (<>) (II Float
x01 Float
x02) (II Float
x11 Float
x12) = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x11 Float
x12)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT 
    then Float -> Float -> IntervalTimI
II (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x11 Float
x12)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x01 Float
x02) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x11 Float
x12)) 
    else IntervalTimI
Empty2
  (<>) (II Float
x Float
y) IntervalTimI
_ = Float -> Float -> IntervalTimI
II Float
x Float
y
  (<>) IntervalTimI
_ (II Float
x Float
y) = Float -> Float -> IntervalTimI
II Float
x Float
y
  (<>) IntervalTimI
_ IntervalTimI
_ = IntervalTimI
UniversalII
#endif
#endif  

-- | Can be understood as an intersection of the sets.
instance Monoid IntervalTimI where
  mempty :: IntervalTimI
mempty = IntervalTimI
Empty2
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__<=802
/* code that applies only to GHC 8.2.* and lower versions */
  mappend Empty2 x = x
  mappend x Empty2 = x
  mappend (II x01 x02) (II x11 x12) = if compare (max (min x01 x02) (min x11 x12)) (min (max x01 x02) (max x11 x12)) /= GT 
    then II (max (min x01 x02) (min x11 x12)) (min (max x01 x02) (max x11 x12)) 
    else Empty2
  mappend _ _ = UniversalII
#endif
#endif
    
-- | The first 'Float' parameter is some adjustment parameter for the playing sound being represented by 'OvertonesO'.
data SoundTim = StOm Timity Float OvertonesO | SAtOm Timity Float Float OvertonesO | SAbtOm Timity Float Float OvertonesO
  deriving (SoundTim -> SoundTim -> Bool
(SoundTim -> SoundTim -> Bool)
-> (SoundTim -> SoundTim -> Bool) -> Eq SoundTim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SoundTim -> SoundTim -> Bool
$c/= :: SoundTim -> SoundTim -> Bool
== :: SoundTim -> SoundTim -> Bool
$c== :: SoundTim -> SoundTim -> Bool
Eq, Eq SoundTim
Eq SoundTim
-> (SoundTim -> SoundTim -> Ordering)
-> (SoundTim -> SoundTim -> Bool)
-> (SoundTim -> SoundTim -> Bool)
-> (SoundTim -> SoundTim -> Bool)
-> (SoundTim -> SoundTim -> Bool)
-> (SoundTim -> SoundTim -> SoundTim)
-> (SoundTim -> SoundTim -> SoundTim)
-> Ord SoundTim
SoundTim -> SoundTim -> Bool
SoundTim -> SoundTim -> Ordering
SoundTim -> SoundTim -> SoundTim
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SoundTim -> SoundTim -> SoundTim
$cmin :: SoundTim -> SoundTim -> SoundTim
max :: SoundTim -> SoundTim -> SoundTim
$cmax :: SoundTim -> SoundTim -> SoundTim
>= :: SoundTim -> SoundTim -> Bool
$c>= :: SoundTim -> SoundTim -> Bool
> :: SoundTim -> SoundTim -> Bool
$c> :: SoundTim -> SoundTim -> Bool
<= :: SoundTim -> SoundTim -> Bool
$c<= :: SoundTim -> SoundTim -> Bool
< :: SoundTim -> SoundTim -> Bool
$c< :: SoundTim -> SoundTim -> Bool
compare :: SoundTim -> SoundTim -> Ordering
$ccompare :: SoundTim -> SoundTim -> Ordering
$cp1Ord :: Eq SoundTim
Ord, Int -> SoundTim -> ShowS
[SoundTim] -> ShowS
SoundTim -> String
(Int -> SoundTim -> ShowS)
-> (SoundTim -> String) -> ([SoundTim] -> ShowS) -> Show SoundTim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SoundTim] -> ShowS
$cshowList :: [SoundTim] -> ShowS
show :: SoundTim -> String
$cshow :: SoundTim -> String
showsPrec :: Int -> SoundTim -> ShowS
$cshowsPrec :: Int -> SoundTim -> ShowS
Show)

----------------------------------------------------------------------------------

-- | Generalized interval representation.
data IntervalG a b = IG a b deriving (IntervalG a b -> IntervalG a b -> Bool
(IntervalG a b -> IntervalG a b -> Bool)
-> (IntervalG a b -> IntervalG a b -> Bool) -> Eq (IntervalG a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => IntervalG a b -> IntervalG a b -> Bool
/= :: IntervalG a b -> IntervalG a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => IntervalG a b -> IntervalG a b -> Bool
== :: IntervalG a b -> IntervalG a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => IntervalG a b -> IntervalG a b -> Bool
Eq, Eq (IntervalG a b)
Eq (IntervalG a b)
-> (IntervalG a b -> IntervalG a b -> Ordering)
-> (IntervalG a b -> IntervalG a b -> Bool)
-> (IntervalG a b -> IntervalG a b -> Bool)
-> (IntervalG a b -> IntervalG a b -> Bool)
-> (IntervalG a b -> IntervalG a b -> Bool)
-> (IntervalG a b -> IntervalG a b -> IntervalG a b)
-> (IntervalG a b -> IntervalG a b -> IntervalG a b)
-> Ord (IntervalG a b)
IntervalG a b -> IntervalG a b -> Bool
IntervalG a b -> IntervalG a b -> Ordering
IntervalG a b -> IntervalG a b -> IntervalG a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (IntervalG a b)
forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Bool
forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Ordering
forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> IntervalG a b
min :: IntervalG a b -> IntervalG a b -> IntervalG a b
$cmin :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> IntervalG a b
max :: IntervalG a b -> IntervalG a b -> IntervalG a b
$cmax :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> IntervalG a b
>= :: IntervalG a b -> IntervalG a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Bool
> :: IntervalG a b -> IntervalG a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Bool
<= :: IntervalG a b -> IntervalG a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Bool
< :: IntervalG a b -> IntervalG a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Bool
compare :: IntervalG a b -> IntervalG a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
IntervalG a b -> IntervalG a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (IntervalG a b)
Ord)

instance (Show a, Show b) => Show (IntervalG a b) where
  show :: IntervalG a b -> String
show (IG a
x b
y) = String
"[|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" __ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|]"

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
-- | Since base-4.9.0.0. Idempotent semigroup (x <> x == x) and rectangular band (x <> y <> z == x <> z)
-- For more information, please, refer to: https://en.wikipedia.org/wiki/Band_(mathematics)
instance Semigroup (IntervalG a b) where
  <> :: IntervalG a b -> IntervalG a b -> IntervalG a b
(<>) (IG a
x0 b
_) (IG a
_ b
w1) = a -> b -> IntervalG a b
forall a b. a -> b -> IntervalG a b
IG a
x0 b
w1
#endif
#endif  

instance Functor (IntervalG a) where
  fmap :: (a -> b) -> IntervalG a a -> IntervalG a b
fmap a -> b
f (IG a
a a
b) = a -> b -> IntervalG a b
forall a b. a -> b -> IntervalG a b
IG a
a (a -> b
f a
b)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
-- | Since base-4.8.0.0. 
instance Bifunctor IntervalG where
  bimap :: (a -> b) -> (c -> d) -> IntervalG a c -> IntervalG b d
bimap a -> b
f c -> d
g (IG a
x c
y) = b -> d -> IntervalG b d
forall a b. a -> b -> IntervalG a b
IG (a -> b
f a
x) (c -> d
g c
y)
#endif
#endif  

-- | Generalized interval representation which is a Monoid instance.
data IntervalMG a = IMG a a | UniversalG deriving (IntervalMG a -> IntervalMG a -> Bool
(IntervalMG a -> IntervalMG a -> Bool)
-> (IntervalMG a -> IntervalMG a -> Bool) -> Eq (IntervalMG a)
forall a. Eq a => IntervalMG a -> IntervalMG a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalMG a -> IntervalMG a -> Bool
$c/= :: forall a. Eq a => IntervalMG a -> IntervalMG a -> Bool
== :: IntervalMG a -> IntervalMG a -> Bool
$c== :: forall a. Eq a => IntervalMG a -> IntervalMG a -> Bool
Eq, Eq (IntervalMG a)
Eq (IntervalMG a)
-> (IntervalMG a -> IntervalMG a -> Ordering)
-> (IntervalMG a -> IntervalMG a -> Bool)
-> (IntervalMG a -> IntervalMG a -> Bool)
-> (IntervalMG a -> IntervalMG a -> Bool)
-> (IntervalMG a -> IntervalMG a -> Bool)
-> (IntervalMG a -> IntervalMG a -> IntervalMG a)
-> (IntervalMG a -> IntervalMG a -> IntervalMG a)
-> Ord (IntervalMG a)
IntervalMG a -> IntervalMG a -> Bool
IntervalMG a -> IntervalMG a -> Ordering
IntervalMG a -> IntervalMG a -> IntervalMG a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (IntervalMG a)
forall a. Ord a => IntervalMG a -> IntervalMG a -> Bool
forall a. Ord a => IntervalMG a -> IntervalMG a -> Ordering
forall a. Ord a => IntervalMG a -> IntervalMG a -> IntervalMG a
min :: IntervalMG a -> IntervalMG a -> IntervalMG a
$cmin :: forall a. Ord a => IntervalMG a -> IntervalMG a -> IntervalMG a
max :: IntervalMG a -> IntervalMG a -> IntervalMG a
$cmax :: forall a. Ord a => IntervalMG a -> IntervalMG a -> IntervalMG a
>= :: IntervalMG a -> IntervalMG a -> Bool
$c>= :: forall a. Ord a => IntervalMG a -> IntervalMG a -> Bool
> :: IntervalMG a -> IntervalMG a -> Bool
$c> :: forall a. Ord a => IntervalMG a -> IntervalMG a -> Bool
<= :: IntervalMG a -> IntervalMG a -> Bool
$c<= :: forall a. Ord a => IntervalMG a -> IntervalMG a -> Bool
< :: IntervalMG a -> IntervalMG a -> Bool
$c< :: forall a. Ord a => IntervalMG a -> IntervalMG a -> Bool
compare :: IntervalMG a -> IntervalMG a -> Ordering
$ccompare :: forall a. Ord a => IntervalMG a -> IntervalMG a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (IntervalMG a)
Ord)

instance (Show a) => Show (IntervalMG a) where
  show :: IntervalMG a -> String
show (IMG a
x a
y) = String
"[|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" __ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|]"
  show IntervalMG a
UniversalG = String
"(-InfinityMG..+InfinityMG)"

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
-- | Since base-4.9.0.0. Idempotent semigroup (x <> x == x) and rectangular band (x <> y <> z == x <> z)
-- For more information, please, refer to: https://en.wikipedia.org/wiki/Band_(mathematics)
instance Semigroup (IntervalMG a) where
  <> :: IntervalMG a -> IntervalMG a -> IntervalMG a
(<>) (IMG a
x0 a
_) (IMG a
_ a
w1) = a -> a -> IntervalMG a
forall a. a -> a -> IntervalMG a
IMG a
x0 a
w1
  (<>) (IMG a
x a
y) IntervalMG a
_ = a -> a -> IntervalMG a
forall a. a -> a -> IntervalMG a
IMG a
x a
y
  (<>) IntervalMG a
_ (IMG a
x a
y) = a -> a -> IntervalMG a
forall a. a -> a -> IntervalMG a
IMG a
x a
y
  (<>) IntervalMG a
_ IntervalMG a
_ = IntervalMG a
forall a. IntervalMG a
UniversalG
#endif
#endif  

instance Monoid (IntervalMG a) where
  mempty :: IntervalMG a
mempty = IntervalMG a
forall a. IntervalMG a
UniversalG
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__<=802
/* code that applies only to GHC 8.2.* and lower versions */
  mappend UniversalG x = x
  mappend x UniversalG = x
  mappend (IMG a1 a2) (IMG a3 a4) = IMG a1 a4
#endif
#endif