module Synthesizer.PiecewiseConstant.Private where

import qualified Synthesizer.Generic.Signal as SigG

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

import qualified Numeric.NonNegative.Wrapper as NonNegW

import Control.Monad.Trans.State (evalState, get, put, )

import qualified Data.List as List
import Data.Traversable (traverse, )
import Data.Foldable (traverse_, )



type StrictTime = NonNegW.Integer
type ShortStrictTime = NonNegW.Int


{-# INLINE toSignal #-}
toSignal ::
   (SigG.Transform sig y) =>
   (StrictTime -> y -> sig y) ->
   EventListBT.T StrictTime y -> sig y
toSignal :: forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> T StrictTime y -> sig y
toSignal StrictTime -> y -> sig y
replicateLong =
   (y -> StrictTime -> sig y -> sig y)
-> sig y -> T StrictTime y -> sig y
forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
      (\y
y StrictTime
t -> sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append (StrictTime -> y -> sig y
replicateLong StrictTime
t y
y))
      sig y
forall sig. Monoid sig => sig
SigG.empty

{-# INLINE toSignalInit #-}
toSignalInit ::
   (SigG.Transform sig y) =>
   (StrictTime -> y -> sig y) ->
   y -> EventList.T StrictTime y -> sig y
toSignalInit :: forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> y -> T StrictTime y -> sig y
toSignalInit StrictTime -> y -> sig y
replicateLong y
initial =
   (\ ~(StrictTime
t,sig y
rest) -> sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append (StrictTime -> y -> sig y
replicateLong StrictTime
t y
initial) sig y
rest)
   ((StrictTime, sig y) -> sig y)
-> (T StrictTime y -> (StrictTime, sig y))
-> T StrictTime y
-> sig y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (StrictTime -> sig y -> (StrictTime, sig y))
-> (y -> (StrictTime, sig y) -> sig y)
-> (StrictTime, sig y)
-> T StrictTime y
-> (StrictTime, sig y)
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
EventList.foldr
      (,)
      (\y
y ~(StrictTime
t,sig y
rest) -> sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append (StrictTime -> y -> sig y
replicateLong StrictTime
t y
y) sig y
rest)
      (StrictTime
0, sig y
forall sig. Monoid sig => sig
SigG.empty)
{-
   toSignal .
--   EventListBM.switchBodyR const .
--   EventListBM.snocTime NonNeg.zero .
--   EventListMB.consBody initial .
   -- switchBodyR causes a space leak
   EventListTM.switchBodyR EventListBT.empty
      (\xs _ -> EventListMT.consBody initial xs)
-}

{-# INLINE toSignalInitWith #-}
toSignalInitWith ::
   (SigG.Transform sig c) =>
   (StrictTime -> c -> sig c) ->
   (y -> c) -> c -> EventList.T StrictTime [y] -> sig c
toSignalInitWith :: forall (sig :: * -> *) c y.
Transform sig c =>
(StrictTime -> c -> sig c)
-> (y -> c) -> c -> T StrictTime [y] -> sig c
toSignalInitWith StrictTime -> c -> sig c
replicateLong y -> c
f c
initial =
   (StrictTime -> c -> sig c) -> c -> T StrictTime c -> sig c
forall (sig :: * -> *) y.
Transform sig y =>
(StrictTime -> y -> sig y) -> y -> T StrictTime y -> sig y
toSignalInit StrictTime -> c -> sig c
replicateLong c
initial (T StrictTime c -> sig c)
-> (T StrictTime [y] -> T StrictTime c)
-> T StrictTime [y]
-> sig c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (State c (T StrictTime c) -> c -> T StrictTime c)
-> c -> State c (T StrictTime c) -> T StrictTime c
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (T StrictTime c) -> c -> T StrictTime c
forall s a. State s a -> s -> a
evalState c
initial (State c (T StrictTime c) -> T StrictTime c)
-> (T StrictTime [y] -> State c (T StrictTime c))
-> T StrictTime [y]
-> T StrictTime c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([y] -> StateT c Identity c)
-> T StrictTime [y] -> State c (T StrictTime c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T StrictTime a -> f (T StrictTime b)
traverse (\[y]
evs -> (y -> StateT c Identity ()) -> [y] -> StateT c Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (c -> StateT c Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (c -> StateT c Identity ())
-> (y -> c) -> y -> StateT c Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> c
f) [y]
evs StateT c Identity () -> StateT c Identity c -> StateT c Identity c
forall a b.
StateT c Identity a -> StateT c Identity b -> StateT c Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT c Identity c
forall (m :: * -> *) s. Monad m => StateT s m s
get)


{- |
Returns a list of non-zero times.
-}
{-# INLINE chopLongTime #-}
chopLongTime :: StrictTime -> [ShortStrictTime]
chopLongTime :: StrictTime -> [ShortStrictTime]
chopLongTime StrictTime
n =
   let d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
       (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod (StrictTime -> Integer
forall a. T a -> a
NonNegW.toNumber StrictTime
n) Integer
d
   in  (Integer -> ShortStrictTime) -> [Integer] -> [ShortStrictTime]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> ShortStrictTime
forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"chopLongTime" (Int -> ShortStrictTime)
-> (Integer -> Int) -> Integer -> ShortStrictTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) ([Integer] -> [ShortStrictTime]) -> [Integer] -> [ShortStrictTime]
forall a b. (a -> b) -> a -> b
$
       Integer -> Integer -> [Integer]
forall i a. Integral i => i -> a -> [a]
List.genericReplicate Integer
q Integer
d [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++
       if Integer
rInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0 then [Integer
r] else []