{- |
Support for stateful modifiers like controlled filters.
-}
module Synthesizer.Plain.Modifier where

import Control.Monad.State (State(..), zipWithM, evalState)

import qualified Data.List as List

import Prelude hiding (init)


-- Signal.T, re-defined here in order to avoid module cycle
type T a = [a]


data Simple s ctrl a b =
   Simple {
      init :: s,
      step :: ctrl -> a -> State s 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?
-}
static ::
   Simple s ctrl a b -> ctrl -> T a -> T b
static modif control x =
   evalState (mapM (step modif control) x) (init modif)

{-| Here the control may vary over the time. -}
modulated ::
   Simple s ctrl a b -> T ctrl -> T a -> T b
modulated modif control x =
   evalState (zipWithM (step modif) control x) (init modif)


data Initialized s init ctrl a b =
   Initialized {
      initInit :: init -> s,
      initStep :: ctrl -> a -> State s b
   }


initialize ::
   Initialized s init ctrl a b -> init -> Simple s ctrl a b
initialize modif stateInit =
   Simple (initInit modif stateInit) (initStep modif)

staticInit ::
   Initialized s init ctrl a b -> init -> ctrl -> T a -> T b
staticInit modif state =
   static (initialize modif state)

{-| Here the control may vary over the time. -}
modulatedInit ::
   Initialized s init ctrl a b -> init -> T ctrl -> T a -> T b
modulatedInit modif state =
   modulated (initialize modif state)



{- |
The number of stacked state monads
depends on the size of the list of state values.
This is like a dynamically nested StateT.
-}
stackStatesR :: (a -> State s a) -> (a -> State [s] a)
stackStatesR m =
   State . List.mapAccumR (runState . m)

stackStatesL :: (a -> State s a) -> (a -> State [s] a)
stackStatesL m =
   State . List.mapAccumL (runState . m)