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

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

module DobutokO.Sound.Effects.Remix 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 Data.List (intersperse)

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

data Vol3 a = P | I | V | P2 a | I2 a | V2 a deriving Vol3 a -> Vol3 a -> Bool
(Vol3 a -> Vol3 a -> Bool)
-> (Vol3 a -> Vol3 a -> Bool) -> Eq (Vol3 a)
forall a. Eq a => Vol3 a -> Vol3 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vol3 a -> Vol3 a -> Bool
$c/= :: forall a. Eq a => Vol3 a -> Vol3 a -> Bool
== :: Vol3 a -> Vol3 a -> Bool
$c== :: forall a. Eq a => Vol3 a -> Vol3 a -> Bool
Eq

instance (Show a, RealFloat a) => Show (Vol3 a) where
  show :: Vol3 a -> String
show Vol3 a
P = String
"p0"
  show Vol3 a
I = String
"i0"
  show Vol3 a
V = String
"v1"
  show (P2 a
a) = Char
'p'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
a String
""
  show (I2 a
a) = Char
'i'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
a String
""
  show (V2 a
a) = Char
'v'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
a String
""

vol31 :: Vol3 Float -> Float
vol31 :: Vol3 Float -> Float
vol31 Vol3 Float
P = Float
0.0
vol31 Vol3 Float
I = Float
0.0
vol31 Vol3 Float
V = Float
1.0
vol31 (P2 Float
x) = Float
x
vol31 (I2 Float
x) = Float
x
vol31 (V2 Float
x) = Float
x

vol3Set1 :: Float -> Vol3 Float -> Vol3 Float
vol3Set1 :: Float -> Vol3 Float -> Vol3 Float
vol3Set1 Float
x Vol3 Float
P 
 | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = Vol3 Float
forall a. Vol3 a
P
 | Bool
otherwise = Float -> Vol3 Float
forall a. a -> Vol3 a
P2 Float
x
vol3Set1 Float
x Vol3 Float
I 
 | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = Vol3 Float
forall a. Vol3 a
I
 | Bool
otherwise = Float -> Vol3 Float
forall a. a -> Vol3 a
I2 Float
x
vol3Set1 Float
x Vol3 Float
V 
 | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
1.0 = Vol3 Float
forall a. Vol3 a
V
 | Bool
otherwise = Float -> Vol3 Float
forall a. a -> Vol3 a
V2 Float
x
vol3Set1 Float
x (P2 Float
_) = Float -> Vol3 Float
forall a. a -> Vol3 a
P2 Float
x
vol3Set1 Float
x (I2 Float
_) = Float -> Vol3 Float
forall a. a -> Vol3 a
I2 Float
x
vol3Set1 Float
x (V2 Float
_) = Float -> Vol3 Float
forall a. a -> Vol3 a
V2 Float
x

type Vol3F = Vol3 Float

data IChannel a b = ICh a (Vol3 b) deriving IChannel a b -> IChannel a b -> Bool
(IChannel a b -> IChannel a b -> Bool)
-> (IChannel a b -> IChannel a b -> Bool) -> Eq (IChannel a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => IChannel a b -> IChannel a b -> Bool
/= :: IChannel a b -> IChannel a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => IChannel a b -> IChannel a b -> Bool
== :: IChannel a b -> IChannel a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => IChannel a b -> IChannel a b -> Bool
Eq

ichannel1 :: IChannel a b -> a
ichannel1 :: IChannel a b -> a
ichannel1 (ICh a
x Vol3 b
_) = a
x

ichannel2 :: Vol3F -> IChannel a Float -> Vol3F
ichannel2 :: Vol3 Float -> IChannel a Float -> Vol3 Float
ichannel2 Vol3 Float
P (ICh a
_ Vol3 Float
y) = Vol3 Float
y
ichannel2 Vol3 Float
I (ICh a
_ Vol3 Float
y) = Vol3 Float
y
ichannel2 Vol3 Float
V (ICh a
_ Vol3 Float
y) = Vol3 Float
y
ichannel2 (P2 Float
_) (ICh a
_ Vol3 Float
y) = Float -> Vol3 Float
forall a. a -> Vol3 a
P2 (Vol3 Float -> Float
vol31 Vol3 Float
y)
ichannel2 (I2 Float
_) (ICh a
_ Vol3 Float
y) = Float -> Vol3 Float
forall a. a -> Vol3 a
I2 (Vol3 Float -> Float
vol31 Vol3 Float
y)
ichannel2 (V2 Float
_) (ICh a
_ Vol3 Float
y) = Float -> Vol3 Float
forall a. a -> Vol3 a
V2 (Vol3 Float -> Float
vol31 Vol3 Float
y)

ichannel2C :: IChannel a b -> String
ichannel2C :: IChannel a b -> String
ichannel2C (ICh a
_ Vol3 b
P) = String
"P"
ichannel2C (ICh a
_ Vol3 b
I) = String
"I"
ichannel2C (ICh a
_ Vol3 b
V) = String
"V"
ichannel2C (ICh a
_ (P2 b
_)) = String
"P2"
ichannel2C (ICh a
_ (I2 b
_)) = String
"I2"
ichannel2C (ICh a
_ (V2 b
_)) = String
"V2"

ichannel21 :: IChannel a Float -> Float
ichannel21 :: IChannel a Float -> Float
ichannel21 (ICh a
_ Vol3 Float
y) = Vol3 Float -> Float
vol31 Vol3 Float
y

ichannelSet1 :: a -> IChannel a b -> IChannel a b
ichannelSet1 :: a -> IChannel a b -> IChannel a b
ichannelSet1 a
x (ICh a
_ Vol3 b
y) = a -> Vol3 b -> IChannel a b
forall a b. a -> Vol3 b -> IChannel a b
ICh a
x Vol3 b
y

ichannelSet2 :: Vol3 b -> IChannel a b -> IChannel a b
ichannelSet2 :: Vol3 b -> IChannel a b -> IChannel a b
ichannelSet2 Vol3 b
y (ICh a
x Vol3 b
_) = a -> Vol3 b -> IChannel a b
forall a b. a -> Vol3 b -> IChannel a b
ICh a
x Vol3 b
y

type IChanF = IChannel Int Float

instance (Show a, Integral a, Show b, RealFloat b) => Show (IChannel a b) where
  show :: IChannel a b -> String
show (ICh a
x Vol3 b
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [a -> String
forall a. Show a => a -> String
show a
x, Vol3 b -> String
forall a. Show a => a -> String
show Vol3 b
y]

data OChannel a = OCh [a] deriving OChannel a -> OChannel a -> Bool
(OChannel a -> OChannel a -> Bool)
-> (OChannel a -> OChannel a -> Bool) -> Eq (OChannel a)
forall a. Eq a => OChannel a -> OChannel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OChannel a -> OChannel a -> Bool
$c/= :: forall a. Eq a => OChannel a -> OChannel a -> Bool
== :: OChannel a -> OChannel a -> Bool
$c== :: forall a. Eq a => OChannel a -> OChannel a -> Bool
Eq

instance (Show a) => Show (OChannel a) where
  show :: OChannel a -> String
show (OCh []) = []
  show (OCh [a
x]) = a -> String
forall a. Show a => a -> String
show a
x
  show (OCh [a]
ys) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"," ([String] -> [String]) -> ([a] -> [String]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ [a]
ys

ochannel1 :: OChannel a -> [a]
ochannel1 :: OChannel a -> [a]
ochannel1 (OCh [a]
xs) = [a]
xs

ochannelSet1 :: [a] -> OChannel a -> OChannel a
ochannelSet1 :: [a] -> OChannel a -> OChannel a
ochannelSet1 [a]
xs OChannel a
_ = [a] -> OChannel a
forall a. [a] -> OChannel a
OCh [a]
xs

type OChanF = OChannel IChanF

data MixSpec = A | M | D deriving MixSpec -> MixSpec -> Bool
(MixSpec -> MixSpec -> Bool)
-> (MixSpec -> MixSpec -> Bool) -> Eq MixSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MixSpec -> MixSpec -> Bool
$c/= :: MixSpec -> MixSpec -> Bool
== :: MixSpec -> MixSpec -> Bool
$c== :: MixSpec -> MixSpec -> Bool
Eq

instance Show MixSpec where
  show :: MixSpec -> String
show MixSpec
A = String
"-a "
  show MixSpec
M = String
"-m "
  show MixSpec
D = []

data Remix a b = Rmx | Rmix a [b] deriving Remix a b -> Remix a b -> Bool
(Remix a b -> Remix a b -> Bool)
-> (Remix a b -> Remix a b -> Bool) -> Eq (Remix a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Remix a b -> Remix a b -> Bool
/= :: Remix a b -> Remix a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Remix a b -> Remix a b -> Bool
== :: Remix a b -> Remix a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Remix a b -> Remix a b -> Bool
Eq

instance Show (Remix MixSpec OChanF) where
  show :: Remix MixSpec OChanF -> String
show (Rmix MixSpec
x [OChanF]
ys) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"remix ",MixSpec -> String
forall a. Show a => a -> String
show MixSpec
x, [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([OChanF] -> [String]) -> [OChanF] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([OChanF] -> [String]) -> [OChanF] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OChanF -> String) -> [OChanF] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OChanF -> String
forall a. Show a => a -> String
show ([OChanF] -> String) -> [OChanF] -> String
forall a b. (a -> b) -> a -> b
$ [OChanF]
ys]
  show Remix MixSpec OChanF
Rmx = String
"remix -"

remixC :: Remix a b -> String
remixC :: Remix a b -> String
remixC Remix a b
Rmx = String
"Rmx"
remixC (Rmix a
_ [b]
_) = String
"Rmix"

remix1 :: Remix a b -> Maybe a
remix1 :: Remix a b -> Maybe a
remix1 Remix a b
Rmx = Maybe a
forall a. Maybe a
Nothing
remix1 (Rmix a
x [b]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

remix2 :: Remix a b -> [b]
remix2 :: Remix a b -> [b]
remix2 Remix a b
Rmx = []
remix2 (Rmix a
_ [b]
xs) = [b]
xs

type ReMix = Remix MixSpec OChanF

remixSet1 :: MixSpec -> ReMix -> ReMix
remixSet1 :: MixSpec -> Remix MixSpec OChanF -> Remix MixSpec OChanF
remixSet1 MixSpec
_ Remix MixSpec OChanF
Rmx = Remix MixSpec OChanF
forall a b. Remix a b
Rmx
remixSet1 MixSpec
y (Rmix MixSpec
_ [OChanF]
xs) = MixSpec -> [OChanF] -> Remix MixSpec OChanF
forall a b. a -> [b] -> Remix a b
Rmix MixSpec
y [OChanF]
xs

remixSet2 :: [OChanF] -> ReMix -> ReMix
remixSet2 :: [OChanF] -> Remix MixSpec OChanF -> Remix MixSpec OChanF
remixSet2 [OChanF]
ys Remix MixSpec OChanF
Rmx = MixSpec -> [OChanF] -> Remix MixSpec OChanF
forall a b. a -> [b] -> Remix a b
Rmix MixSpec
D [OChanF]
ys
remixSet2 [OChanF]
ys (Rmix MixSpec
x [OChanF]
_) = MixSpec -> [OChanF] -> Remix MixSpec OChanF
forall a b. a -> [b] -> Remix a b
Rmix MixSpec
x [OChanF]
ys

showRmQ :: ReMix -> [String]
showRmQ :: Remix MixSpec OChanF -> [String]
showRmQ = String -> [String]
words (String -> [String])
-> (Remix MixSpec OChanF -> String)
-> Remix MixSpec OChanF
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Remix MixSpec OChanF -> String
forall a. Show a => a -> String
show