{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Generic.LengthSignal where

import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG

import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup, (<>), )
import Data.Tuple.HT (mapSnd, )

import qualified Algebra.Additive       as Additive

import NumericPrelude.Numeric as NP
import NumericPrelude.Base hiding (length, splitAt, )


data T sig = Cons {forall sig. T sig -> Int
length :: Int, forall sig. T sig -> sig
body :: sig}
   deriving (Int -> T sig -> ShowS
[T sig] -> ShowS
T sig -> String
(Int -> T sig -> ShowS)
-> (T sig -> String) -> ([T sig] -> ShowS) -> Show (T sig)
forall sig. Show sig => Int -> T sig -> ShowS
forall sig. Show sig => [T sig] -> ShowS
forall sig. Show sig => T sig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall sig. Show sig => Int -> T sig -> ShowS
showsPrec :: Int -> T sig -> ShowS
$cshow :: forall sig. Show sig => T sig -> String
show :: T sig -> String
$cshowList :: forall sig. Show sig => [T sig] -> ShowS
showList :: [T sig] -> ShowS
Show)

fromSignal :: (CutG.Read sig) => sig -> T sig
fromSignal :: forall sig. Read sig => sig -> T sig
fromSignal sig
xs  =  Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (sig -> Int
forall sig. Read sig => sig -> Int
CutG.length sig
xs) sig
xs

toSignal :: T sig -> sig
toSignal :: forall sig. T sig -> sig
toSignal  =  T sig -> sig
forall sig. T sig -> sig
body

{- |
Each fmap must preserve the signal length.
-}
instance Functor T where
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f (Cons Int
xl a
xs) = Int -> b -> T b
forall sig. Int -> sig -> T sig
Cons Int
xl (a -> b
f a
xs)

instance (Additive.C a, SigG.Transform sig a) => Additive.C (T (sig a)) where
   zero :: T (sig a)
zero = T (sig a)
forall a. Monoid a => a
mempty
   negate :: T (sig a) -> T (sig a)
negate T (sig a)
xs = T (sig a)
xs{body = SigG.map negate (body xs)}
   (Cons Int
xl sig a
xs) + :: T (sig a) -> T (sig a) -> T (sig a)
+ (Cons Int
yl sig a
ys) =
      Int -> sig a -> T (sig a)
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
xl Int
yl) (sig a -> sig a -> sig a
forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix sig a
xs sig a
ys)

instance (Semigroup sig) => Semigroup (T sig) where
   Cons Int
xl sig
xs <> :: T sig -> T sig -> T sig
<> Cons Int
yl sig
ys = Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int
xlInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
yl) (sig
xs sig -> sig -> sig
forall a. Semigroup a => a -> a -> a
<> sig
ys)

instance (Monoid sig) => Monoid (T sig) where
   mempty :: T sig
mempty = Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons Int
forall a. C a => a
zero sig
forall a. Monoid a => a
mempty
   mappend :: T sig -> T sig -> T sig
mappend (Cons Int
xl sig
xs) (Cons Int
yl sig
ys) =
      Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int
xlInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
yl) (sig -> sig -> sig
forall a. Monoid a => a -> a -> a
mappend sig
xs sig
ys)

splitAt :: (CutG.Transform sig) => Int -> T sig -> (T sig, T sig)
splitAt :: forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
splitAt Int
n (Cons Int
xl sig
xs) =
   let (sig
ys,sig
zs) = Int -> sig -> (sig, sig)
forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
n sig
xs
   in  (Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
xl) sig
ys, Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
xl Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
n) sig
zs)

{- |
It must hold @delay <= length a@.
-}
{-
It is crucial that 'mix' uses the chunk size structure of the second operand.
This way we avoid unnecessary and even infinite look-ahead.
-}
{-# INLINE addShiftedSimple #-}
addShiftedSimple ::
   (Additive.C a, SigG.Transform sig a) =>
   Int -> T (sig a) -> T (sig a) -> T (sig a)
addShiftedSimple :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> T (sig a) -> T (sig a) -> T (sig a)
addShiftedSimple Int
del T (sig a)
a T (sig a)
b =
   (T (sig a) -> T (sig a) -> T (sig a))
-> (T (sig a), T (sig a)) -> T (sig a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T (sig a) -> T (sig a) -> T (sig a)
forall a. Monoid a => a -> a -> a
mappend ((T (sig a), T (sig a)) -> T (sig a))
-> (T (sig a), T (sig a)) -> T (sig a)
forall a b. (a -> b) -> a -> b
$
   (T (sig a) -> T (sig a))
-> (T (sig a), T (sig a)) -> (T (sig a), T (sig a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T (sig a) -> T (sig a) -> T (sig a))
-> T (sig a) -> T (sig a) -> T (sig a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip T (sig a) -> T (sig a) -> T (sig a)
forall a. C a => a -> a -> a
(+) T (sig a)
b) ((T (sig a), T (sig a)) -> (T (sig a), T (sig a)))
-> (T (sig a), T (sig a)) -> (T (sig a), T (sig a))
forall a b. (a -> b) -> a -> b
$
   Int -> T (sig a) -> (T (sig a), T (sig a))
forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
splitAt Int
del T (sig a)
a