{-# OPTIONS_GHC -O -fglasgow-exts #-}
{- glasgow-exts are for the rules -}
{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  portable
-}
module Synthesizer.Plain.Signal where

import qualified Synthesizer.Generic.Signal as SigG
import qualified Sound.Signal as Signal

import qualified Algebra.Additive              as Additive

import qualified Synthesizer.Plain.Modifier as Modifier
import Synthesizer.Utility (viewListL, viewListR, )

import qualified NumericPrelude.List as NPList
import qualified Data.List as List


type T a = [a]


{- * Generic routines that are useful for filters -}

type Modifier s ctrl a b = Modifier.Simple s ctrl a b

{-|
modif is a process controlled by values of type c
with an internal state of type s,
it converts an input value of type a into an output value of type b
while turning into a new state

ToDo:
Shall finite signals be padded with zeros?
-}
modifyStatic ::
   Modifier s ctrl a b -> ctrl -> T a -> T b
modifyStatic = Modifier.static

{-| Here the control may vary over the time. -}
modifyModulated ::
   Modifier s ctrl a b -> T ctrl -> T a -> T b
modifyModulated = Modifier.modulated


type ModifierInit s init ctrl a b = Modifier.Initialized s init ctrl a b


modifierInitialize ::
   ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
modifierInitialize = Modifier.initialize

modifyStaticInit ::
   ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
modifyStaticInit = Modifier.staticInit

{-| Here the control may vary over the time. -}
modifyModulatedInit ::
   ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
modifyModulatedInit = Modifier.modulatedInit



instance Signal.C [] where
   singleton = (:[])
   unfoldR   = unfoldR
   reduceL   = reduceL
   mapAccumL = mapAccumL
   (++)      = (List.++)
   zipWith   = List.zipWith

unfoldR :: (acc -> Maybe (y, acc)) -> acc -> (acc, T y)
unfoldR f =
   let recurse acc0 =
          maybe
             (acc0,[])
             (\(y,acc1) ->
                let (accEnd, signal) = recurse acc1
                in  (accEnd, y : signal))
             (f acc0)
   in  recurse

reduceL :: (x -> acc -> Maybe acc) -> acc -> T x -> acc
reduceL f =
   let recurse a xt =
          case xt of
             [] -> a
             (x:xs) ->
                maybe a
                   (\ a' -> seq a' (recurse a' xs))
                   (f x a)
   in  recurse

mapAccumL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL f =
   let recurse acc0 xt =
          case xt of
             [] -> (acc0,[])
             (x:xs) ->
                 maybe
                    (acc0,[])
                    (\(y,acc1) ->
                       let (accEnd, signal) = recurse acc1 xs
                       in  (accEnd, y : signal))
                    (f x acc0)
   in  recurse

crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL f a = snd . mapAccumL f a


{- |
Feed back signal into signal processor,
and apply a delay by one value.
'fix1' is a kind of 'Signal.generate'.
-}
fix1 :: y -> (T y -> T y) -> T y
fix1 pad f =
   let y = f (pad:y)
   in  y

{-# RULES
  "fix1/crochetL" forall f a b.
     fix1 a (Signal.crochetL f b) =
        Signal.generate (\(a0,b0) ->
            do yb1@(y0,_) <- f a0 b0
               return (y0, yb1)) (a,b) ;
  #-}


instance SigG.C [] where
   empty = []
   null = List.null
   cons = (:)
   fromList = id
   toList = id
   repeat = List.repeat
   cycle = List.cycle
   replicate = List.replicate
   iterate = List.iterate
   iterateAssoc = NPList.iterateAssoc
   unfoldR = List.unfoldr
   map = List.map
   mix = (Additive.+)
   zipWith = List.zipWith
   scanL = List.scanl
   viewL = viewListL
   viewR = viewListR
   foldL = List.foldl
   length = List.length
   take = List.take
   drop = List.drop
   splitAt = List.splitAt
   dropMarginRem = dropMarginRem
   takeWhile = List.takeWhile
   dropWhile = List.dropWhile
   span = List.span
   append = (List.++)
   concat = List.concat
   reverse = List.reverse
{-
   mapAccumL = List.mapAccumL
   mapAccumR = List.mapAccumR
-}
   crochetL = crochetL

{-
instance SigG.Data [] y where

instance SigG.C [] where
   add = (Additive.+)
   map = List.map
   zipWith = List.zipWith
-}


{- |
@dropMarginRem n m xs@
drops at most the first @m@ elements of @xs@
and ensures that @xs@ still contains @n@ elements.
Additionally returns the number of elements that could not be dropped
due to the margin constraint.
That is @dropMarginRem n m xs == (k,ys)@ implies @length xs - m == length ys - k@.
Requires @length xs >= n@.
-}
dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem n m =
   head .
   dropMargin n m .
   zipWithTails (,) (iterate pred m)

dropMargin :: Int -> Int -> T a -> T a
dropMargin n m xs =
   NPList.dropMatch (take m (drop n xs)) xs

{- |
Can be implemented more efficiently
than just by 'zipWith' and 'List.tails'
for other data structures.
-}
zipWithTails ::
   (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails f xs =
   zipWith f xs . init . List.tails