module Synthesizer.PiecewiseConstant.Storable (
   toSignal,
   toSignalInit,
   toSignalInitWith,
   ) where

import qualified Synthesizer.PiecewiseConstant.Private as PC
import Synthesizer.PiecewiseConstant.Private (StrictTime)

import qualified Synthesizer.Storable.Signal     as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy        as SVL

import qualified Data.EventList.Relative.BodyTime  as EventListBT
import qualified Data.EventList.Relative.TimeBody  as EventList

import Foreign.Storable (Storable, )

import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky



chunkSizesFromStrictTime :: StrictTime -> NonNegChunky.T SigSt.ChunkSize
chunkSizesFromStrictTime :: StrictTime -> T ChunkSize
chunkSizesFromStrictTime =
   [ChunkSize] -> T ChunkSize
forall a. C a => [a] -> T a
NonNegChunky.fromChunks ([ChunkSize] -> T ChunkSize)
-> (StrictTime -> [ChunkSize]) -> StrictTime -> T ChunkSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T Int -> ChunkSize) -> [T Int] -> [ChunkSize]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ChunkSize
SVL.ChunkSize (Int -> ChunkSize) -> (T Int -> Int) -> T Int -> ChunkSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Int -> Int
forall a. T a -> a
NonNegW.toNumber) ([T Int] -> [ChunkSize])
-> (StrictTime -> [T Int]) -> StrictTime -> [ChunkSize]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   StrictTime -> [T Int]
PC.chopLongTime


replicateLong :: (Storable y) => StrictTime -> y -> SigSt.T y
replicateLong :: forall y. Storable y => StrictTime -> y -> T y
replicateLong StrictTime
t y
y =
   T ChunkSize -> y -> Vector y
forall a. Storable a => T ChunkSize -> a -> Vector a
SigStV.replicate (StrictTime -> T ChunkSize
chunkSizesFromStrictTime StrictTime
t) y
y

{-# INLINE toSignal #-}
toSignal :: (Storable y) => EventListBT.T StrictTime y -> SigSt.T y
toSignal :: forall y. Storable y => T StrictTime y -> T y
toSignal = (StrictTime -> y -> Vector y) -> T StrictTime y -> Vector y
forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> T StrictTime y -> sig y
PC.toSignal StrictTime -> y -> Vector y
forall y. Storable y => StrictTime -> y -> T y
replicateLong

{-# INLINE toSignalInit #-}
toSignalInit :: (Storable y) => y -> EventList.T StrictTime y -> SigSt.T y
toSignalInit :: forall y. Storable y => y -> T StrictTime y -> T y
toSignalInit = (StrictTime -> y -> Vector y) -> y -> T StrictTime y -> Vector y
forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> y -> T StrictTime y -> sig y
PC.toSignalInit StrictTime -> y -> Vector y
forall y. Storable y => StrictTime -> y -> T y
replicateLong

{-# INLINE toSignalInitWith #-}
toSignalInitWith ::
   (Storable c) =>
   (y -> c) -> c -> EventList.T StrictTime [y] -> SigSt.T c
toSignalInitWith :: forall c y. Storable c => (y -> c) -> c -> T StrictTime [y] -> T c
toSignalInitWith = (StrictTime -> c -> Vector c)
-> (y -> c) -> c -> T StrictTime [y] -> Vector c
forall (sig :: * -> *) c y.
Transform sig c =>
(StrictTime -> c -> sig c)
-> (y -> c) -> c -> T StrictTime [y] -> sig c
PC.toSignalInitWith StrictTime -> c -> Vector c
forall y. Storable y => StrictTime -> y -> T y
replicateLong