{-# 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
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
showList :: [T sig] -> ShowS
$cshowList :: forall sig. Show sig => [T sig] -> ShowS
show :: T sig -> String
$cshow :: forall sig. Show sig => T sig -> String
showsPrec :: Int -> T sig -> ShowS
$cshowsPrec :: forall sig. Show sig => Int -> T sig -> ShowS
Show)

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

toSignal :: T sig -> sig
toSignal :: forall sig. T sig -> sig
toSignal  =  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) = 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 = forall a. Monoid a => a
mempty
   negate :: T (sig a) -> T (sig a)
negate T (sig a)
xs = T (sig a)
xs{body :: sig a
body = forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map forall a. C a => a -> a
negate (forall sig. T sig -> sig
body T (sig a)
xs)}
   (Cons Int
xl sig a
xs) + :: T (sig a) -> T (sig a) -> T (sig a)
+ (Cons Int
yl sig a
ys) =
      forall sig. Int -> sig -> T sig
Cons (forall a. Ord a => a -> a -> a
max Int
xl Int
yl) (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 = forall sig. Int -> sig -> T sig
Cons (Int
xlforall a. C a => a -> a -> a
+Int
yl) (sig
xs forall a. Semigroup a => a -> a -> a
<> sig
ys)

instance (Monoid sig) => Monoid (T sig) where
   mempty :: T sig
mempty = forall sig. Int -> sig -> T sig
Cons forall a. C a => a
zero forall a. Monoid a => a
mempty
   mappend :: T sig -> T sig -> T sig
mappend (Cons Int
xl sig
xs) (Cons Int
yl sig
ys) =
      forall sig. Int -> sig -> T sig
Cons (Int
xlforall a. C a => a -> a -> a
+Int
yl) (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) = forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
n sig
xs
   in  (forall sig. Int -> sig -> T sig
Cons (forall a. Ord a => a -> a -> a
min Int
n Int
xl) sig
ys, forall sig. Int -> sig -> T sig
Cons (forall a. Ord a => a -> a -> a
max Int
n Int
xl 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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$
   forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. C a => a -> a -> a
(+) T (sig a)
b) forall a b. (a -> b) -> a -> b
$
   forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
splitAt Int
del T (sig a)
a