-- | 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 (Mce t -> Mce t -> Bool
Mce t -> Mce t -> Ordering
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
min :: Mce t -> Mce t -> Mce t
$cmin :: forall t. Ord t => Mce t -> Mce t -> Mce t
max :: Mce t -> Mce t -> Mce t
$cmax :: forall t. Ord t => Mce t -> Mce t -> Mce t
>= :: 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
$c< :: forall t. Ord t => Mce t -> Mce t -> Bool
compare :: Mce t -> Mce t -> Ordering
$ccompare :: forall t. Ord t => Mce t -> Mce t -> Ordering
Ord, Mce t -> Mce t -> Bool
forall t. Eq t => Mce t -> Mce t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mce t -> Mce t -> Bool
$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
Eq, ReadPrec [Mce t]
ReadPrec (Mce t)
ReadS [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
readListPrec :: ReadPrec [Mce t]
$creadListPrec :: forall t. Read t => ReadPrec [Mce t]
readPrec :: ReadPrec (Mce t)
$creadPrec :: forall t. Read t => ReadPrec (Mce t)
readList :: ReadS [Mce t]
$creadList :: forall t. Read t => ReadS [Mce t]
readsPrec :: Int -> ReadS (Mce t)
$creadsPrec :: forall t. Read t => Int -> ReadS (Mce t)
Read, Int -> Mce t -> ShowS
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
showList :: [Mce t] -> ShowS
$cshowList :: forall t. Show t => [Mce t] -> ShowS
show :: Mce t -> String
$cshow :: forall t. Show t => Mce t -> String
showsPrec :: Int -> Mce t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> 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 -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce t]
v forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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
    [] -> forall a. HasCallStack => String -> a
error String
"mce_from_list: null?"
    [t
e] -> forall t. t -> Mce t
Mce_Scalar t
e
    [t]
_ -> forall t. [Mce t] -> Mce t
Mce_Vector (forall a b. (a -> b) -> [a] -> [b]
map forall t. t -> Mce t
Mce_Scalar [t]
l)

{- | toList for Mce.

> let v = Mce_Vector in 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 -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall t. Mce t -> [t]
mce_to_list [Mce t]
e

{- | Pretty printer for Mce.

> let v = Mce_Vector in 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 forall a. a -> [a] -> [a]
: [a]
x forall a. [a] -> [a] -> [a]
++ [a
r]
  in case Mce t
m of
       Mce_Scalar t
e -> forall a. Show a => a -> String
show t
e
       Mce_Vector [Mce t]
e -> forall {a}. (a, a) -> [a] -> [a]
bracketed (Char
'[',Char
']') (forall a. [a] -> [[a]] -> [a]
Sound.Sc3.Common.Base.concat_intersperse String
", " (forall a b. (a -> b) -> [a] -> [b]
map 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]
_ -> 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 -> 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 in mce_depth (v[v[1, 2], 3, v[4, 5]]) == 2
> let v = Mce_Vector in 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall t. Mce t -> Bool
mce_is_scalar [Mce a]
v then Int
1 else Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map 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
_ -> forall t. [Mce t] -> Mce t
Mce_Vector (forall a. Int -> a -> [a]
replicate Int
n Mce t
m)
      Mce_Vector [Mce t]
e -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce t]
e forall a. Ord a => a -> a -> Bool
> Int
n then forall a. HasCallStack => String -> a
error String
"mce_extend?" else forall t. [Mce t] -> Mce t
Mce_Vector (forall a. Int -> [a] -> [a]
take Int
n (forall a. [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 -> forall t. t -> Mce t
Mce_Scalar (a -> b
f a
e)
      Mce_Vector [Mce a]
e -> forall t. [Mce t] -> Mce t
Mce_Vector (forall a b. (a -> b) -> [a] -> [b]
map (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 = 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) -> forall t. t -> Mce t
Mce_Scalar (a -> b -> c
f a
e1 b
e2)
      (Mce_Scalar a
_,Mce_Vector [Mce b]
e2) -> forall t. [Mce t] -> Mce t
Mce_Vector (forall a b. (a -> b) -> [a] -> [b]
map (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
_) -> forall t. [Mce t] -> Mce t
Mce_Vector (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 = forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce a]
e1) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mce b]
e2)
              ext :: [a] -> [a]
ext = forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle
          in forall t. [Mce t] -> Mce t
Mce_Vector (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> Mce a -> Mce b -> Mce c
mce_binop a -> b -> c
f) (forall a. [a] -> [a]
ext [Mce a]
e1) (forall a. [a] -> [a]
ext [Mce b]
e2))

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

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

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

-}