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

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

module DobutokO.Sound.Effects.Speed 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 Cents = E | C deriving Cents -> Cents -> Bool
(Cents -> Cents -> Bool) -> (Cents -> Cents -> Bool) -> Eq Cents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cents -> Cents -> Bool
$c/= :: Cents -> Cents -> Bool
== :: Cents -> Cents -> Bool
$c== :: Cents -> Cents -> Bool
Eq

instance Show Cents where
  show :: Cents -> String
show Cents
C = String
"c"
  show Cents
_ = String
""
  
data Speed a b = Spd a b deriving Speed a b -> Speed a b -> Bool
(Speed a b -> Speed a b -> Bool)
-> (Speed a b -> Speed a b -> Bool) -> Eq (Speed a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Speed a b -> Speed a b -> Bool
/= :: Speed a b -> Speed a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Speed a b -> Speed a b -> Bool
== :: Speed a b -> Speed a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Speed a b -> Speed a b -> Bool
Eq

instance Show (Speed Float Cents) where
  show :: Speed Float Cents -> String
show (Spd Float
x Cents
y) = [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
"",Cents -> String
forall a. Show a => a -> String
show Cents
y]

type Spd2 = Speed Float Cents

speed1 :: Speed a b -> a
speed1 :: Speed a b -> a
speed1 (Spd a
x b
_)   = a
x

speed2 :: Speed a b -> b
speed2 :: Speed a b -> b
speed2 (Spd a
_ b
y) = b
y

speedSet1 :: a -> Speed a b -> Speed a b
speedSet1 :: a -> Speed a b -> Speed a b
speedSet1 a
x (Spd a
_ b
y)   = a -> b -> Speed a b
forall a b. a -> b -> Speed a b
Spd a
x b
y

speedSet2 :: b -> Speed a b -> Speed a b
speedSet2 :: b -> Speed a b -> Speed a b
speedSet2 b
y (Spd a
x b
_) = a -> b -> Speed a b
forall a b. a -> b -> Speed a b
Spd a
x b
y

showSpdQ :: Spd2 -> [String]
showSpdQ :: Speed Float Cents -> [String]
showSpdQ = String -> [String]
words (String -> [String])
-> (Speed Float Cents -> String) -> Speed Float Cents -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Speed Float Cents -> String
forall a. Show a => a -> String
show