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

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

module DobutokO.Sound.Presentation (
  -- * Sound repesentations
  SoundI (..)
  , SoundFN (..)
  , SoundT (..)
  -- * Sound time intervals representations
  , Timity (..)
  , Timity1 (..)
  , IntervalTim (..)
  , IntervalTimI (..)
  , IntervalG (..)
) 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 DobutokO.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


-- | 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 Double Double OvertonesO | SAi Int Double Double Double OvertonesO | SAbi Int Double Double Double OvertonesO
  deriving 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 Double Double | SAn FilePath String Double Double Double | SAbn FilePath String Double Double Double
  deriving Eq

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

-- | The first 'Double' 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 Double Double Double Double OvertonesO | SAtO Double Double Double Double Double OvertonesO |
  SAbtO Double Double Double Double Double OvertonesO deriving Eq

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

-- | The first 'Double' 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 Double Double Double deriving Eq

instance Ord Timity where
  compare (Time t01 t11 t21) (Time t02 t12 t22)
    | t01 /= t02 = compare t01 t02
    | abs t11 /= abs t12 = compare (abs t11) (abs t12)
    | otherwise = compare (abs t22) (abs t21)

instance Show Timity where
  show (Time t0 t1 t2) = showFFloat Nothing t0 ":(" ++ showFFloat Nothing t1 "):(" ++ showFFloat Nothing t2 ")"

-- | The first 'Double' 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 Double Double a

instance (Eq a) => Eq (Timity1 a) where
  (==) (Time1 x1 x2 a0) (Time1 x3 x4 a1)
    | a0 /= a1 = False
    | x1 /= x3 = False
    | otherwise = x2 == x4

instance (Ord a) => Ord (Timity1 a) where
  compare (Time1 t01 t11 a0) (Time1 t02 t12 a1)
    | t01 /= t02 = compare t01 t02
    | abs t11 /= abs t12 = compare (abs t11) (abs t12)
    | otherwise = compare a0 a1

instance (Show a) => Show (Timity1 a) where
  show (Time1 t0 t1 a1) = showFFloat Nothing t0 ":(" ++ showFFloat Nothing t1 "):(" ++ show a1 ++ ")"

instance Functor Timity1 where
  fmap f (Time1 t1 t2 a0) = Time1 t1 t2 (f 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
  (<>) (Time1 t01 t11 a0) (Time1 t02 t12 a1) = Time1 (min t01 t02) ((signum (t11 * t12)) * (max (t01 + (abs t11)) (t02 + (abs t12)) - min t01 t02))
          (a0 <> a1)
#endif
#endif

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

instance Eq IntervalTim where
  (==) (I x1 x2) (I y1 y2)
    | x1 /= y1 = if x1 == y2 then x2 == y1 else False
    | otherwise = x2 == y2

instance Ord IntervalTim where
  compare (I x01 x02) (I x11 x12)
    | min x01 x02 == min x11 x12 = compare (max x01 x02) (max x11 x12)
    | otherwise = compare (min x01 x02) (min x11 x12)

instance Show IntervalTim where
  show (I x1 x2)
    | compare x1 x2 /= GT = "[" ++ showFFloat Nothing x1 ", " ++ showFFloat Nothing x2 "]"
    | otherwise = "[" ++ showFFloat Nothing x2 ", " ++ showFFloat Nothing x1 "]"

#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
  (<>) (I x01 x02) (I x11 x12) = I (minimum [x01,x02,x11,x12]) (maximum [x01,x02,x11,x12])
#endif
#endif

-- | Another 'Double' interval representation with no order of the arguments preserved. Since base-4.9.0.0 has different instance of 'Semigroup' 
-- than 'IntervalTim'.
data IntervalTimI = II Double Double

instance Eq IntervalTimI where
  (==) (II x1 x2) (II y1 y2)
    | x1 /= y1 = if x1 == y2 then x2 == y1 else False
    | otherwise = x2 == y2

instance Ord IntervalTimI where
  compare (II x01 x02) (II x11 x12)
    | min x01 x02 == min x11 x12 = compare (max x01 x02) (max x11 x12)
    | otherwise = compare (min x01 x02) (min x11 x12)

instance Show IntervalTimI where
  show (II x1 x2)
    | compare x1 x2 /= GT = "[" ++ showFFloat Nothing x1 ", " ++ showFFloat Nothing x2 "]"
    | otherwise = "[" ++ showFFloat Nothing x2 ", " ++ showFFloat Nothing x1 "]"

#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 IntervalTimI where
  (<>) (II x01 x02) (II x11 x12) = II (max (min x01 x02) (min x11 x12)) (min (max x01 x02) (max x11 x12))
#endif
#endif  

-- | The first 'Double' parameter is some adjustment parameter for the playing sound being represented by 'OvertonesO'.
data SoundTim = StOm Timity Double OvertonesO | SAtOm Timity Double Double OvertonesO | SAbtOm Timity Double Double OvertonesO
  deriving (Eq, Ord, Show)

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

-- | Generalized interval representation.
data IntervalG a b = IG a b

instance (Eq a, Eq b) => Eq (IntervalG a b) where
  (==) (IG a0 b0) (IG a1 b1)
    | a0 /= a1 = False
    | otherwise = b0 == b1

instance (Ord a, Ord b) => Ord (IntervalG a b) where
  compare (IG a0 b0) (IG a1 b1)
    | a0 /= a1 = compare a0 a1
    | otherwise = compare b0 b1

instance (Show a, Show b) => Show (IntervalG a b) where
  show (IG x y) = "[|" ++ show x ++ " __ " ++ show y ++ "|]"

#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
  (<>) (IG x0 _) (IG _ w1) = IG x0 w1
#endif
#endif  

instance Functor (IntervalG a) where
  fmap f (IG a b) = IG a (f 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 f g (IG x y) = IG (f x) (g y)
#endif
#endif