{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.PiecewiseConstant.Signal (
   T,
   StrictTime,
   ShortStrictTime,
   LazyTime,
   subdivideLazy,
   subdivideLazyToShort,
   subdivideLongStrict,
   chopLongTime,
   longFromShortTime,
   zipWith,
   ) where

import Synthesizer.PiecewiseConstant.Private
         (StrictTime, ShortStrictTime, chopLongTime)

import qualified Data.EventList.Relative.TimeTime  as EventListTT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.BodyTime  as EventListBT

import qualified Numeric.NonNegative.Class   as NonNeg
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import Numeric.NonNegative.Class ((-|), )

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

import qualified Data.List as List
import Data.Maybe.HT (toMaybe, )

import NumericPrelude.Numeric
import NumericPrelude.Base hiding (zipWith, )
import qualified Prelude as P


type LazyTime = NonNegChunky.T StrictTime

type T = EventListBT.T StrictTime


{-# INLINE subdivideLazy #-}
subdivideLazy ::
   (NonNeg.C time) =>
   EventListBT.T (NonNegChunky.T time) body ->
   EventListBT.T time body
subdivideLazy :: forall time body. C time => T (T time) body -> T time body
subdivideLazy =
   forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
      (\body
y T time
lt T time body
r ->
         forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr
            (\time
dt ->
               forall body time. body -> T time body -> T time body
EventListMT.consBody body
y forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               forall time body. time -> T time body -> T time body
EventListMT.consTime time
dt) T time body
r forall a b. (a -> b) -> a -> b
$
         forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize T time
lt))
      forall time body. T time body
EventListBT.empty

{- |
Subdivide lazy times into chunks that fit into the number range
representable by @Int@.
-}
{-# INLINE subdivideLazyToShort #-}
subdivideLazyToShort ::
   EventListBT.T LazyTime y -> EventListBT.T ShortStrictTime y
subdivideLazyToShort :: forall y. T LazyTime y -> T ShortStrictTime y
subdivideLazyToShort =
   forall time body. C time => T (T time) body -> T time body
subdivideLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
      (forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap StrictTime -> [ShortStrictTime]
chopLongTime forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a. T a -> [a]
NonNegChunky.toChunks)

{-# INLINE longFromShortTime #-}
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime =
   forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"longFromShortTime" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. T a -> a
NonNegW.toNumber


{-# INLINE subdivideLongStrict #-}
subdivideLongStrict ::
   EventListBT.T StrictTime y -> EventListBT.T ShortStrictTime y
subdivideLongStrict :: forall y. T StrictTime y -> T ShortStrictTime y
subdivideLongStrict =
   forall time body. C time => T (T time) body -> T time body
subdivideLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
      (forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTime -> [ShortStrictTime]
chopLongTime)


_subdivideMaybe ::
   EventListBT.T LazyTime y -> EventListBT.T StrictTime (Maybe y)
_subdivideMaybe :: forall y. T LazyTime y -> T StrictTime (Maybe y)
_subdivideMaybe =
   forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
      (\y
y LazyTime
lt T StrictTime (Maybe y)
r ->
         case forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
            [] -> T StrictTime (Maybe y)
r
            (StrictTime
t:[StrictTime]
ts) ->
               forall body time. body -> time -> T time body -> T time body
EventListBT.cons (forall a. a -> Maybe a
Just y
y) StrictTime
t forall a b. (a -> b) -> a -> b
$
               forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (forall body time. body -> time -> T time body -> T time body
EventListBT.cons forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts)
      forall time body. T time body
EventListBT.empty

{- |
When a lazy time value is split into chunks
then do not just replicate the sample for the whole time,
but insert 'Nothing's.
-}
{-# INLINE subdivideMaybe #-}
subdivideMaybe ::
   EventListTT.T LazyTime y ->
   EventListTT.T StrictTime (Maybe y)
subdivideMaybe :: forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe =
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
EventListTT.foldr
      (\LazyTime
lt T StrictTime (Maybe y)
r ->
         forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> T time body -> T time body
EventListMT.consTime forall a b. (a -> b) -> a -> b
$
         case forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
            [] ->
               (forall a. (Ord a, Num a) => a -> T a
NonNegW.fromNumber forall a. C a => a
zero, T StrictTime (Maybe y)
r)
            (StrictTime
t:[StrictTime]
ts) ->
               (StrictTime
t, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (forall body time. body -> time -> T time body -> T time body
EventListBT.cons forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts))
      (\y
y T StrictTime (Maybe y)
r -> forall body time. body -> T time body -> T time body
EventListMT.consBody (forall a. a -> Maybe a
Just y
y) T StrictTime (Maybe y)
r)
      forall time body. T time body
EventListBT.empty

{-# INLINE unionMaybe #-}
unionMaybe ::
   EventListTT.T StrictTime (Maybe y) ->
   EventListTT.T LazyTime y
unionMaybe :: forall y. T StrictTime (Maybe y) -> T LazyTime y
unionMaybe =
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
EventListTT.foldr
      (\StrictTime
t ->
         forall time body. (time -> time) -> T time body -> T time body
EventListMT.mapTimeHead
            (forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictTime
tforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> [a]
NonNegChunky.toChunks))
      (\Maybe y
my ->
         case Maybe y
my of
            Maybe y
Nothing -> forall a. a -> a
id
            Just y
y ->
               forall time body. time -> T time body -> T time body
EventListMT.consTime forall a. T a
NonNegChunky.zero forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               forall body time. body -> T time body -> T time body
EventListMT.consBody y
y)
      (forall time body. time -> T time body
EventListTT.pause forall a. T a
NonNegChunky.zero)

zipWithCore ::
   (NonNeg.C time) =>
   (a -> b -> c) ->
   a -> b ->
   EventListTT.T time (Maybe a) ->
   EventListTT.T time (Maybe b) ->
   EventListTT.T time (Maybe c)
zipWithCore :: forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f =
   let switch :: b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
ac T time (Maybe b)
ar (Bool, b) -> T time (Maybe b) -> T time body
g =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time (Maybe b)
ar forall a b. (a -> b) -> a -> b
$ \Maybe b
am T time (Maybe b)
ar1 ->
          (Bool, b) -> T time (Maybe b) -> T time body
g (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,b
ac) ((,) Bool
True) Maybe b
am) T time (Maybe b)
ar1
       cont :: Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
j a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs =
          forall body time. body -> T time body -> T time body
EventListMT.consBody (forall a. Bool -> a -> Maybe a
toMaybe Bool
j forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
ac b
bc) forall a b. (a -> b) -> a -> b
$
          a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs
       recourse :: a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe a)
as forall a b. (a -> b) -> a -> b
$ \time
at T time (Maybe a)
ar ->
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe b)
bs forall a b. (a -> b) -> a -> b
$ \time
bt T time (Maybe b)
br ->
          let ct :: time
ct = forall a. Ord a => a -> a -> a
min time
at time
bt
          in  -- ToDo: redundant comparison of 'at' and 'bt'
              forall time body. time -> T time body -> T time body
EventListMT.consTime time
ct forall a b. (a -> b) -> a -> b
$
              case forall a. Ord a => a -> a -> Ordering
compare time
at time
bt of
                 Ordering
LT ->
                    forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch a
ac T time (Maybe a)
ar forall a b. (a -> b) -> a -> b
$ \(Bool
ab,a
a) T time (Maybe a)
ar1 ->
                       Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
ab a
a b
bc T time (Maybe a)
ar1 (forall time body. time -> T time body -> T time body
EventListMT.consTime (time
btforall a. C a => a -> a -> a
-|time
ct) T time (Maybe b)
br)
                 Ordering
GT ->
                    forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
bc T time (Maybe b)
br forall a b. (a -> b) -> a -> b
$ \(Bool
bb,b
b) T time (Maybe b)
br1 ->
                       Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
bb a
ac b
b (forall time body. time -> T time body -> T time body
EventListMT.consTime (time
atforall a. C a => a -> a -> a
-|time
ct) T time (Maybe a)
ar) T time (Maybe b)
br1
                 Ordering
EQ ->
                    forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch a
ac T time (Maybe a)
ar forall a b. (a -> b) -> a -> b
$ \(Bool
ab,a
a) T time (Maybe a)
ar1 ->
                    forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
bc T time (Maybe b)
br forall a b. (a -> b) -> a -> b
$ \(Bool
bb,b
b) T time (Maybe b)
br1 ->
                       Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont (Bool
abBool -> Bool -> Bool
||Bool
bb) a
a b
b T time (Maybe a)
ar1 T time (Maybe b)
br1
   in  forall {time}.
C time =>
a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse

zipWith ::
   (NonNeg.C time) =>
   (a -> b -> c) ->
   EventListBT.T time a ->
   EventListBT.T time b ->
   EventListBT.T time c
zipWith :: forall time a b c.
C time =>
(a -> b -> c) -> T time a -> T time b -> T time c
zipWith a -> b -> c
f T time a
as0 T time b
bs0 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time a
as0 forall a b. (a -> b) -> a -> b
$ \a
a0 T time a
as1 ->
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time b
bs0 forall a b. (a -> b) -> a -> b
$ \b
b0 T time b
bs1 ->
   let c0 :: c
c0 = a -> b -> c
f a
a0 b
b0
   in  forall body time. body -> T time body -> T time body
EventListMT.consBody c
c0 forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState c
c0 forall a b. (a -> b) -> a -> b
$
       forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Maybe c
mc -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Maybe c
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => StateT s m s
get) forall a b. (a -> b) -> a -> b
$
       forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f a
a0 b
b0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just T time a
as1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just T time b
bs1)

_zipWithLazy ::
   (a -> b -> c) ->
   EventListBT.T LazyTime a ->
   EventListBT.T LazyTime b ->
   EventListBT.T LazyTime c
_zipWithLazy :: forall a b c.
(a -> b -> c) -> T LazyTime a -> T LazyTime b -> T LazyTime c
_zipWithLazy a -> b -> c
f T LazyTime a
as0 T LazyTime b
bs0 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T LazyTime a
as0 forall a b. (a -> b) -> a -> b
$ \a
a0 T LazyTime a
as1 ->
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T LazyTime b
bs0 forall a b. (a -> b) -> a -> b
$ \b
b0 T LazyTime b
bs1 ->
   forall body time. body -> T time body -> T time body
EventListMT.consBody (a -> b -> c
f a
a0 b
b0) forall a b. (a -> b) -> a -> b
$ forall y. T StrictTime (Maybe y) -> T LazyTime y
unionMaybe forall a b. (a -> b) -> a -> b
$
   forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f a
a0 b
b0 (forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe T LazyTime a
as1) (forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe T LazyTime b
bs1)
{-
*Synthesizer.PiecewiseConstant.ALSA.MIDI Data.EventList.Relative.MixedTime> zipWithLazy (,) ('a' ./ 2 /. 'b' ./ 7 /. EventListBT.empty) ('c' ./ (1 P.+ 1) /. 'd' ./ 1 /. EventListBT.empty)
-}