-- | The Sc3 multiple channel expansion (Mce) rules over an abstract type.
module Sound.Sc3.Common.Mce where

import qualified Sound.Sc3.Common.Base {- hsc3 -}

{- | Multiple channel expansion.
The Mce type is a tree, however in hsc3 Mce_Vector will always hold Mce_Scalar elements.
-}
data Mce t = Mce_Scalar t | Mce_Vector [Mce t]
  deriving (Eq (Mce t)
Eq (Mce t) =>
(Mce t -> Mce t -> Ordering)
-> (Mce t -> Mce t -> Bool)
-> (Mce t -> Mce t -> Bool)
-> (Mce t -> Mce t -> Bool)
-> (Mce t -> Mce t -> Bool)
-> (Mce t -> Mce t -> Mce t)
-> (Mce t -> Mce t -> Mce t)
-> Ord (Mce t)
Mce t -> Mce t -> Bool
Mce t -> Mce t -> Ordering
Mce t -> Mce t -> Mce t
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 t. Ord t => Eq (Mce t)
forall t. Ord t => Mce t -> Mce t -> Bool
forall t. Ord t => Mce t -> Mce t -> Ordering
forall t. Ord t => Mce t -> Mce t -> Mce t
$ccompare :: forall t. Ord t => Mce t -> Mce t -> Ordering
compare :: Mce t -> Mce t -> Ordering
$c< :: forall t. Ord t => Mce t -> Mce t -> Bool
< :: Mce t -> Mce t -> Bool
$c<= :: forall t. Ord t => Mce t -> Mce t -> Bool
<= :: Mce t -> Mce t -> Bool
$c> :: forall t. Ord t => Mce t -> Mce t -> Bool
> :: Mce t -> Mce t -> Bool
$c>= :: forall t. Ord t => Mce t -> Mce t -> Bool
>= :: Mce t -> Mce t -> Bool
$cmax :: forall t. Ord t => Mce t -> Mce t -> Mce t
max :: Mce t -> Mce t -> Mce t
$cmin :: forall t. Ord t => Mce t -> Mce t -> Mce t
min :: Mce t -> Mce t -> Mce t
Ord, Mce t -> Mce t -> Bool
(Mce t -> Mce t -> Bool) -> (Mce t -> Mce t -> Bool) -> Eq (Mce t)
forall t. Eq t => Mce t -> Mce t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Mce t -> Mce t -> Bool
== :: Mce t -> Mce t -> Bool
$c/= :: forall t. Eq t => Mce t -> Mce t -> Bool
/= :: Mce t -> Mce t -> Bool
Eq, ReadPrec [Mce t]
ReadPrec (Mce t)
Int -> ReadS (Mce t)
ReadS [Mce t]
(Int -> ReadS (Mce t))
-> ReadS [Mce t]
-> ReadPrec (Mce t)
-> ReadPrec [Mce t]
-> Read (Mce t)
forall t. Read t => ReadPrec [Mce t]
forall t. Read t => ReadPrec (Mce t)
forall t. Read t => Int -> ReadS (Mce t)
forall t. Read t => ReadS [Mce t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. Read t => Int -> ReadS (Mce t)
readsPrec :: Int -> ReadS (Mce t)
$creadList :: forall t. Read t => ReadS [Mce t]
readList :: ReadS [Mce t]
$creadPrec :: forall t. Read t => ReadPrec (Mce t)
readPrec :: ReadPrec (Mce t)
$creadListPrec :: forall t. Read t => ReadPrec [Mce t]
readListPrec :: ReadPrec [Mce t]
Read, Int -> Mce t -> ShowS
[Mce t] -> ShowS
Mce t -> String
(Int -> Mce t -> ShowS)
-> (Mce t -> String) -> ([Mce t] -> ShowS) -> Show (Mce t)
forall t. Show t => Int -> Mce t -> ShowS
forall t. Show t => [Mce t] -> ShowS
forall t. Show t => Mce t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Mce t -> ShowS
showsPrec :: Int -> Mce t -> ShowS
$cshow :: forall t. Show t => Mce t -> String
show :: Mce t -> String
$cshowList :: forall t. Show t => [Mce t] -> ShowS
showList :: [Mce t] -> ShowS
Show)

{- | There are two invariants:
1. Mce should not be empty, ie. Mce_Vector should not have a null list.
2. Scalar Mce values should not be written as one-place vectors.

>>> mce_is_well_formed (Mce_Vector [])
False

>>> mce_is_well_formed (Mce_Vector [Mce_Scalar 1])
False
-}
mce_is_well_formed :: Mce t -> Bool
mce_is_well_formed :: forall t. Mce t -> Bool
mce_is_well_formed Mce t
m =
  case Mce t
m of
    Mce_Scalar t
_ -> Bool
True
    Mce_Vector [Mce t]
v -> [Mce t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce t]
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& (Mce t -> Bool) -> [Mce t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Mce t -> Bool
forall t. Mce t -> Bool
mce_is_well_formed [Mce t]
v

-- | Is Mce scalar.
mce_is_scalar :: Mce t -> Bool
mce_is_scalar :: forall t. Mce t -> Bool
mce_is_scalar Mce t
m =
  case Mce t
m of
    Mce_Scalar t
_ -> Bool
True
    Mce t
_ -> Bool
False

-- | fromList for Mce, generates well-formed Mce.
mce_from_list :: [t] -> Mce t
mce_from_list :: forall t. [t] -> Mce t
mce_from_list [t]
l =
  case [t]
l of
    [] -> String -> Mce t
forall a. HasCallStack => String -> a
error String
"mce_from_list: null?"
    [t
e] -> t -> Mce t
forall t. t -> Mce t
Mce_Scalar t
e
    [t]
_ -> [Mce t] -> Mce t
forall t. [Mce t] -> Mce t
Mce_Vector ((t -> Mce t) -> [t] -> [Mce t]
forall a b. (a -> b) -> [a] -> [b]
map t -> Mce t
forall t. t -> Mce t
Mce_Scalar [t]
l)

{- | toList for Mce.

>>> let v = Mce_Vector
>>> mce_to_list (v[v[1, 2], 3, v[4, 5]])
[1,2,3,4,5]
-}
mce_to_list :: Mce t -> [t]
mce_to_list :: forall t. Mce t -> [t]
mce_to_list Mce t
m =
  case Mce t
m of
    Mce_Scalar t
e -> [t
e]
    Mce_Vector [Mce t]
e -> (Mce t -> [t]) -> [Mce t] -> [t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mce t -> [t]
forall t. Mce t -> [t]
mce_to_list [Mce t]
e

{- | Pretty printer for Mce.

>>> let v = Mce_Vector
>>> mce_show (v[1, 2, v[3, 4]] * 5 + v[6, 7, 8])
"[11, 17, [23, 28]]"
-}
mce_show :: Show t => Mce t -> String
mce_show :: forall t. Show t => Mce t -> String
mce_show Mce t
m =
  let bracketed :: (a, a) -> [a] -> [a]
bracketed (a
l, a
r) [a]
x = a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
r]
  in case Mce t
m of
      Mce_Scalar t
e -> t -> String
forall a. Show a => a -> String
show t
e
      Mce_Vector [Mce t]
e -> (Char, Char) -> ShowS
forall {a}. (a, a) -> [a] -> [a]
bracketed (Char
'[', Char
']') (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Sound.Sc3.Common.Base.concat_intersperse String
", " ((Mce t -> String) -> [Mce t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Mce t -> String
forall t. Show t => Mce t -> String
mce_show [Mce t]
e))

-- | Read value from Mce_Scalar, error if Mce is Mce_Vector
mce_scalar_value :: Mce t -> t
mce_scalar_value :: forall t. Mce t -> t
mce_scalar_value Mce t
m =
  case Mce t
m of
    Mce_Scalar t
x -> t
x
    Mce_Vector [Mce t]
_ -> String -> t
forall a. HasCallStack => String -> a
error String
"mce_scalar_value: not Mce_Scalar"

{- | Length, or perhaps rather width, of Mce.
Considers only the outermost level, i.e. mce_length is not necessarily the length of mce_to_list.
-}
mce_length :: Mce a -> Int
mce_length :: forall a. Mce a -> Int
mce_length Mce a
m =
  case Mce a
m of
    Mce_Scalar a
_ -> Int
1
    Mce_Vector [Mce a]
e -> [Mce a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce a]
e

{- | The depth of an Mce is the longest sequence of nested Mce_Vector nodes.

>>> mce_depth 1
1

>>> mce_depth (Mce_Vector [1, 2])
1

>>> let v = Mce_Vector
>>> mce_depth (v[v[1, 2], 3, v[4, 5]])
2

>>> mce_depth (v[v[1, 2, 3, v[4, 5], 6], 7])
3
-}
mce_depth :: Mce a -> Int
mce_depth :: forall a. Mce a -> Int
mce_depth Mce a
m =
  case Mce a
m of
    Mce_Scalar a
_ -> Int
1
    Mce_Vector [Mce a]
v -> if (Mce a -> Bool) -> [Mce a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Mce a -> Bool
forall t. Mce t -> Bool
mce_is_scalar [Mce a]
v then Int
1 else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Mce a -> Int) -> [Mce a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Mce a -> Int
forall a. Mce a -> Int
mce_depth [Mce a]
v)

{- | Extend Mce to specified degree.
Considers only the outermost level.
-}
mce_extend :: Int -> Mce t -> Mce t
mce_extend :: forall t. Int -> Mce t -> Mce t
mce_extend Int
n Mce t
m =
  case Mce t
m of
    Mce_Scalar t
_ -> [Mce t] -> Mce t
forall t. [Mce t] -> Mce t
Mce_Vector (Int -> Mce t -> [Mce t]
forall a. Int -> a -> [a]
replicate Int
n Mce t
m)
    Mce_Vector [Mce t]
e -> if [Mce t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce t]
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n then String -> Mce t
forall a. HasCallStack => String -> a
error String
"mce_extend?" else [Mce t] -> Mce t
forall t. [Mce t] -> Mce t
Mce_Vector (Int -> [Mce t] -> [Mce t]
forall a. Int -> [a] -> [a]
take Int
n ([Mce t] -> [Mce t]
forall a. HasCallStack => [a] -> [a]
cycle [Mce t]
e))

-- | fmap for Mce, apply /f/ at elements of /m/.
mce_map :: (a -> b) -> Mce a -> Mce b
mce_map :: forall a b. (a -> b) -> Mce a -> Mce b
mce_map a -> b
f Mce a
m =
  case Mce a
m of
    Mce_Scalar a
e -> b -> Mce b
forall t. t -> Mce t
Mce_Scalar (a -> b
f a
e)
    Mce_Vector [Mce a]
e -> [Mce b] -> Mce b
forall t. [Mce t] -> Mce t
Mce_Vector ((Mce a -> Mce b) -> [Mce a] -> [Mce b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Mce a -> Mce b
forall a b. (a -> b) -> Mce a -> Mce b
mce_map a -> b
f) [Mce a]
e)

instance Functor Mce where fmap :: forall a b. (a -> b) -> Mce a -> Mce b
fmap = (a -> b) -> Mce a -> Mce b
forall a b. (a -> b) -> Mce a -> Mce b
mce_map

{- | Apply /f/ pairwise at elements of /m1/ and /m2/.
     At each level this extends the shorter of the two operands.
-}
mce_binop :: (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop :: forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop a -> b -> c
f Mce a
m1 Mce b
m2 =
  case (Mce a
m1, Mce b
m2) of
    (Mce_Scalar a
e1, Mce_Scalar b
e2) -> c -> Mce c
forall t. t -> Mce t
Mce_Scalar (a -> b -> c
f a
e1 b
e2)
    (Mce_Scalar a
_, Mce_Vector [Mce b]
e2) -> [Mce c] -> Mce c
forall t. [Mce t] -> Mce t
Mce_Vector ((Mce b -> Mce c) -> [Mce b] -> [Mce c]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> c) -> Mce a -> Mce b -> Mce c
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop a -> b -> c
f Mce a
m1) [Mce b]
e2)
    (Mce_Vector [Mce a]
e1, Mce_Scalar b
_) -> [Mce c] -> Mce c
forall t. [Mce t] -> Mce t
Mce_Vector ((Mce a -> Mce c) -> [Mce a] -> [Mce c]
forall a b. (a -> b) -> [a] -> [b]
map ((Mce a -> Mce b -> Mce c) -> Mce b -> Mce a -> Mce c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> b -> c) -> Mce a -> Mce b -> Mce c
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop a -> b -> c
f) Mce b
m2) [Mce a]
e1)
    (Mce_Vector [Mce a]
e1, Mce_Vector [Mce b]
e2) ->
      let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Mce a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce a]
e1) ([Mce b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce b]
e2)
          ext :: [a] -> [a]
ext = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. HasCallStack => [a] -> [a]
cycle
      in [Mce c] -> Mce c
forall t. [Mce t] -> Mce t
Mce_Vector ((Mce a -> Mce b -> Mce c) -> [Mce a] -> [Mce b] -> [Mce c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> b -> c) -> Mce a -> Mce b -> Mce c
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop a -> b -> c
f) ([Mce a] -> [Mce a]
forall {a}. [a] -> [a]
ext [Mce a]
e1) ([Mce b] -> [Mce b]
forall {a}. [a] -> [a]
ext [Mce b]
e2))

instance Num n => Num (Mce n) where
  + :: Mce n -> Mce n -> Mce n
(+) = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop n -> n -> n
forall a. Num a => a -> a -> a
(+)
  (-) = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop (-)
  * :: Mce n -> Mce n -> Mce n
(*) = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop n -> n -> n
forall a. Num a => a -> a -> a
(*)
  abs :: Mce n -> Mce n
abs = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
mce_map n -> n
forall a. Num a => a -> a
abs
  negate :: Mce n -> Mce n
negate = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
mce_map n -> n
forall a. Num a => a -> a
negate
  signum :: Mce n -> Mce n
signum = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
mce_map n -> n
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Mce n
fromInteger = n -> Mce n
forall t. t -> Mce t
Mce_Scalar (n -> Mce n) -> (Integer -> n) -> Integer -> Mce n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> n
forall a. Num a => Integer -> a
fromInteger

instance Fractional n => Fractional (Mce n) where
  / :: Mce n -> Mce n -> Mce n
(/) = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop n -> n -> n
forall a. Fractional a => a -> a -> a
(/)
  fromRational :: Rational -> Mce n
fromRational = n -> Mce n
forall t. t -> Mce t
Mce_Scalar (n -> Mce n) -> (Rational -> n) -> Rational -> Mce n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> n
forall a. Fractional a => Rational -> a
fromRational

instance Floating n => Floating (Mce n) where
  pi :: Mce n
pi = n -> Mce n
forall t. t -> Mce t
Mce_Scalar n
forall a. Floating a => a
pi
  exp :: Mce n -> Mce n
exp = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
exp
  log :: Mce n -> Mce n
log = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
log
  sqrt :: Mce n -> Mce n
sqrt = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
sqrt
  ** :: Mce n -> Mce n -> Mce n
(**) = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop n -> n -> n
forall a. Floating a => a -> a -> a
(**)
  logBase :: Mce n -> Mce n -> Mce n
logBase = (n -> n -> n) -> Mce n -> Mce n -> Mce n
forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop n -> n -> n
forall a. Floating a => a -> a -> a
logBase
  sin :: Mce n -> Mce n
sin = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
sin
  cos :: Mce n -> Mce n
cos = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
cos
  asin :: Mce n -> Mce n
asin = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
asin
  acos :: Mce n -> Mce n
acos = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
acos
  atan :: Mce n -> Mce n
atan = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
atan
  sinh :: Mce n -> Mce n
sinh = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
sinh
  cosh :: Mce n -> Mce n
cosh = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
cosh
  asinh :: Mce n -> Mce n
asinh = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
asinh
  acosh :: Mce n -> Mce n
acosh = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
acosh
  atanh :: Mce n -> Mce n
atanh = (n -> n) -> Mce n -> Mce n
forall a b. (a -> b) -> Mce a -> Mce b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Floating a => a -> a
atanh

{-

If Ugen is any of Functor, Foldable, Traversable, then Mce must be as well.

{-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

-}