{-# 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 =
   (body -> T time -> T time body -> T time body)
-> T time body -> T (T time) body -> T time body
forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
      (\body
y T time
lt T time body
r ->
         (time -> T time body -> T time body)
-> T time body -> [time] -> T time body
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr
            (\time
dt ->
               body -> T time body -> T time body
forall body time. body -> T time body -> T time body
EventListMT.consBody body
y (T time body -> T time body)
-> (T time body -> T time body) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               time -> T time body -> T time body
forall time body. time -> T time body -> T time body
EventListMT.consTime time
dt) T time body
r ([time] -> T time body) -> [time] -> T time body
forall a b. (a -> b) -> a -> b
$
         T time -> [time]
forall a. T a -> [a]
NonNegChunky.toChunks (T time -> T time
forall a. C a => T a -> T a
NonNegChunky.normalize T time
lt))
      T time body
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 =
   T (T ShortStrictTime) y -> T ShortStrictTime y
forall time body. C time => T (T time) body -> T time body
subdivideLazy (T (T ShortStrictTime) y -> T ShortStrictTime y)
-> (T LazyTime y -> T (T ShortStrictTime) y)
-> T LazyTime y
-> T ShortStrictTime y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (LazyTime -> T ShortStrictTime)
-> T LazyTime y -> T (T ShortStrictTime) y
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
      ([ShortStrictTime] -> T ShortStrictTime
forall a. C a => [a] -> T a
NonNegChunky.fromChunks ([ShortStrictTime] -> T ShortStrictTime)
-> (LazyTime -> [ShortStrictTime]) -> LazyTime -> T ShortStrictTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       (StrictTime -> [ShortStrictTime])
-> [StrictTime] -> [ShortStrictTime]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap StrictTime -> [ShortStrictTime]
chopLongTime ([StrictTime] -> [ShortStrictTime])
-> (LazyTime -> [StrictTime]) -> LazyTime -> [ShortStrictTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       LazyTime -> [StrictTime]
forall a. T a -> [a]
NonNegChunky.toChunks)

{-# INLINE longFromShortTime #-}
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime =
   String -> Integer -> StrictTime
forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"longFromShortTime" (Integer -> StrictTime)
-> (ShortStrictTime -> Integer) -> ShortStrictTime -> StrictTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> Integer)
-> (ShortStrictTime -> Int) -> ShortStrictTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ShortStrictTime -> Int
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 =
   T (T ShortStrictTime) y -> T ShortStrictTime y
forall time body. C time => T (T time) body -> T time body
subdivideLazy (T (T ShortStrictTime) y -> T ShortStrictTime y)
-> (T StrictTime y -> T (T ShortStrictTime) y)
-> T StrictTime y
-> T ShortStrictTime y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (StrictTime -> T ShortStrictTime)
-> T StrictTime y -> T (T ShortStrictTime) y
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
      ([ShortStrictTime] -> T ShortStrictTime
forall a. C a => [a] -> T a
NonNegChunky.fromChunks ([ShortStrictTime] -> T ShortStrictTime)
-> (StrictTime -> [ShortStrictTime])
-> StrictTime
-> T ShortStrictTime
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 =
   (y -> LazyTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> T StrictTime (Maybe y) -> T LazyTime y -> T StrictTime (Maybe y)
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 LazyTime -> [StrictTime]
forall a. T a -> [a]
NonNegChunky.toChunks (LazyTime -> LazyTime
forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
            [] -> T StrictTime (Maybe y)
r
            (StrictTime
t:[StrictTime]
ts) ->
               Maybe y
-> StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall body time. body -> time -> T time body -> T time body
EventListBT.cons (y -> Maybe y
forall a. a -> Maybe a
Just y
y) StrictTime
t (T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall a b. (a -> b) -> a -> b
$
               (StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> T StrictTime (Maybe y) -> [StrictTime] -> T StrictTime (Maybe y)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (Maybe y
-> StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall body time. body -> time -> T time body -> T time body
EventListBT.cons Maybe y
forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts)
      T StrictTime (Maybe y)
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 =
   (LazyTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> (y -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> T StrictTime (Maybe y)
-> T LazyTime y
-> T StrictTime (Maybe y)
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 ->
         (StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> (StrictTime, T StrictTime (Maybe y)) -> T StrictTime (Maybe y)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall time body. time -> T time body -> T time body
EventListMT.consTime ((StrictTime, T StrictTime (Maybe y)) -> T StrictTime (Maybe y))
-> (StrictTime, T StrictTime (Maybe y)) -> T StrictTime (Maybe y)
forall a b. (a -> b) -> a -> b
$
         case LazyTime -> [StrictTime]
forall a. T a -> [a]
NonNegChunky.toChunks (LazyTime -> LazyTime
forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
            [] ->
               (Integer -> StrictTime
forall a. (Ord a, Num a) => a -> T a
NonNegW.fromNumber Integer
forall a. C a => a
zero, T StrictTime (Maybe y)
r)
            (StrictTime
t:[StrictTime]
ts) ->
               (StrictTime
t, (StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y))
-> T StrictTime (Maybe y) -> [StrictTime] -> T StrictTime (Maybe y)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (Maybe y
-> StrictTime -> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall body time. body -> time -> T time body -> T time body
EventListBT.cons Maybe y
forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts))
      (\y
y T StrictTime (Maybe y)
r -> Maybe y -> T StrictTime (Maybe y) -> T StrictTime (Maybe y)
forall body time. body -> T time body -> T time body
EventListMT.consBody (y -> Maybe y
forall a. a -> Maybe a
Just y
y) T StrictTime (Maybe y)
r)
      T StrictTime (Maybe y)
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 =
   (StrictTime -> T LazyTime y -> T LazyTime y)
-> (Maybe y -> T LazyTime y -> T LazyTime y)
-> T LazyTime y
-> T StrictTime (Maybe y)
-> T LazyTime y
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
EventListTT.foldr
      (\StrictTime
t ->
         (LazyTime -> LazyTime) -> T LazyTime y -> T LazyTime y
forall time body. (time -> time) -> T time body -> T time body
EventListMT.mapTimeHead
            ([StrictTime] -> LazyTime
forall a. C a => [a] -> T a
NonNegChunky.fromChunks ([StrictTime] -> LazyTime)
-> (LazyTime -> [StrictTime]) -> LazyTime -> LazyTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictTime
tStrictTime -> [StrictTime] -> [StrictTime]
forall a. a -> [a] -> [a]
:) ([StrictTime] -> [StrictTime])
-> (LazyTime -> [StrictTime]) -> LazyTime -> [StrictTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyTime -> [StrictTime]
forall a. T a -> [a]
NonNegChunky.toChunks))
      (\Maybe y
my ->
         case Maybe y
my of
            Maybe y
Nothing -> T LazyTime y -> T LazyTime y
forall a. a -> a
id
            Just y
y ->
               LazyTime -> T LazyTime y -> T LazyTime y
forall time body. time -> T time body -> T time body
EventListMT.consTime LazyTime
forall a. T a
NonNegChunky.zero (T LazyTime y -> T LazyTime y)
-> (T LazyTime y -> T LazyTime y) -> T LazyTime y -> T LazyTime y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               y -> T LazyTime y -> T LazyTime y
forall body time. body -> T time body -> T time body
EventListMT.consBody y
y)
      (LazyTime -> T LazyTime y
forall time body. time -> T time body
EventListTT.pause LazyTime
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 =
          ((Maybe b -> T time (Maybe b) -> T time body)
 -> T time (Maybe b) -> T time body)
-> T time (Maybe b)
-> (Maybe b -> T time (Maybe b) -> T time body)
-> T time body
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time body
-> (Maybe b -> T time (Maybe b) -> T time body)
-> T time (Maybe b)
-> T time body
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL T time body
forall time body. T time body
EventListBT.empty) T time (Maybe b)
ar ((Maybe b -> T time (Maybe b) -> T time body) -> T time body)
-> (Maybe b -> T time (Maybe b) -> T time body) -> T time body
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 ((Bool, b) -> (b -> (Bool, b)) -> Maybe b -> (Bool, b)
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 =
          Maybe c -> T time (Maybe c) -> T time (Maybe c)
forall body time. body -> T time body -> T time body
EventListMT.consBody (Bool -> c -> Maybe c
forall a. Bool -> a -> Maybe a
toMaybe Bool
j (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
ac b
bc) (T time (Maybe c) -> T time (Maybe c))
-> T time (Maybe c) -> T time (Maybe c)
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 =
          ((time -> T time (Maybe a) -> T time (Maybe c))
 -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe a)
-> (time -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe a) -> T time (Maybe c)
forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe a)
as ((time -> T time (Maybe a) -> T time (Maybe c))
 -> T time (Maybe c))
-> (time -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
forall a b. (a -> b) -> a -> b
$ \time
at T time (Maybe a)
ar ->
          ((time -> T time (Maybe b) -> T time (Maybe c))
 -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe b)
-> (time -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe b) -> T time (Maybe c)
forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe b)
bs ((time -> T time (Maybe b) -> T time (Maybe c))
 -> T time (Maybe c))
-> (time -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
forall a b. (a -> b) -> a -> b
$ \time
bt T time (Maybe b)
br ->
          let ct :: time
ct = time -> time -> time
forall a. Ord a => a -> a -> a
min time
at time
bt
          in  -- ToDo: redundant comparison of 'at' and 'bt'
              time -> T time (Maybe c) -> T time (Maybe c)
forall time body. time -> T time body -> T time body
EventListMT.consTime time
ct (T time (Maybe c) -> T time (Maybe c))
-> T time (Maybe c) -> T time (Maybe c)
forall a b. (a -> b) -> a -> b
$
              case time -> time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare time
at time
bt of
                 Ordering
LT ->
                    a
-> T time (Maybe a)
-> ((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
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 (((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
 -> T time (Maybe c))
-> ((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
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 (time -> T time (Maybe b) -> T time (Maybe b)
forall time body. time -> T time body -> T time body
EventListMT.consTime (time
bttime -> time -> time
forall a. C a => a -> a -> a
-|time
ct) T time (Maybe b)
br)
                 Ordering
GT ->
                    b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
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 (((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
 -> T time (Maybe c))
-> ((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
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 (time -> T time (Maybe a) -> T time (Maybe a)
forall time body. time -> T time body -> T time body
EventListMT.consTime (time
attime -> time -> time
forall a. C a => a -> a -> a
-|time
ct) T time (Maybe a)
ar) T time (Maybe b)
br1
                 Ordering
EQ ->
                    a
-> T time (Maybe a)
-> ((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
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 (((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
 -> T time (Maybe c))
-> ((Bool, a) -> T time (Maybe a) -> T time (Maybe c))
-> T time (Maybe c)
forall a b. (a -> b) -> a -> b
$ \(Bool
ab,a
a) T time (Maybe a)
ar1 ->
                    b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
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 (((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
 -> T time (Maybe c))
-> ((Bool, b) -> T time (Maybe b) -> T time (Maybe c))
-> T time (Maybe c)
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  a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
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 =
   ((a -> T time a -> T time c) -> T time a -> T time c)
-> T time a -> (a -> T time a -> T time c) -> T time c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time c -> (a -> T time a -> T time c) -> T time a -> T time c
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL T time c
forall time body. T time body
EventListBT.empty) T time a
as0 ((a -> T time a -> T time c) -> T time c)
-> (a -> T time a -> T time c) -> T time c
forall a b. (a -> b) -> a -> b
$ \a
a0 T time a
as1 ->
   ((b -> T time b -> T time c) -> T time b -> T time c)
-> T time b -> (b -> T time b -> T time c) -> T time c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time c -> (b -> T time b -> T time c) -> T time b -> T time c
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL T time c
forall time body. T time body
EventListBT.empty) T time b
bs0 ((b -> T time b -> T time c) -> T time c)
-> (b -> T time b -> T time c) -> T time c
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  c -> T time c -> T time c
forall body time. body -> T time body -> T time body
EventListMT.consBody c
c0 (T time c -> T time c) -> T time c -> T time c
forall a b. (a -> b) -> a -> b
$
       (State c (T time c) -> c -> T time c)
-> c -> State c (T time c) -> T time c
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (T time c) -> c -> T time c
forall s a. State s a -> s -> a
evalState c
c0 (State c (T time c) -> T time c) -> State c (T time c) -> T time c
forall a b. (a -> b) -> a -> b
$
       (Maybe c -> StateT c Identity c)
-> T time (Maybe c) -> State c (T time 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 time a -> f (T time b)
traverse (\Maybe c
mc -> StateT c Identity ()
-> (c -> StateT c Identity ()) -> Maybe c -> StateT c Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StateT c Identity ()
forall a. a -> StateT c Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) c -> StateT c Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Maybe c
mc 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) (T time (Maybe c) -> State c (T time c))
-> T time (Maybe c) -> State c (T time c)
forall a b. (a -> b) -> a -> b
$
       (a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
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 ((a -> Maybe a) -> T time a -> T time (Maybe a)
forall a b. (a -> b) -> T time a -> T time b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just T time a
as1) ((b -> Maybe b) -> T time b -> T time (Maybe b)
forall a b. (a -> b) -> T time a -> T time b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
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 =
   ((a -> T LazyTime a -> T LazyTime c)
 -> T LazyTime a -> T LazyTime c)
-> T LazyTime a
-> (a -> T LazyTime a -> T LazyTime c)
-> T LazyTime c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T LazyTime c
-> (a -> T LazyTime a -> T LazyTime c)
-> T LazyTime a
-> T LazyTime c
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL T LazyTime c
forall time body. T time body
EventListBT.empty) T LazyTime a
as0 ((a -> T LazyTime a -> T LazyTime c) -> T LazyTime c)
-> (a -> T LazyTime a -> T LazyTime c) -> T LazyTime c
forall a b. (a -> b) -> a -> b
$ \a
a0 T LazyTime a
as1 ->
   ((b -> T LazyTime b -> T LazyTime c)
 -> T LazyTime b -> T LazyTime c)
-> T LazyTime b
-> (b -> T LazyTime b -> T LazyTime c)
-> T LazyTime c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T LazyTime c
-> (b -> T LazyTime b -> T LazyTime c)
-> T LazyTime b
-> T LazyTime c
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL T LazyTime c
forall time body. T time body
EventListBT.empty) T LazyTime b
bs0 ((b -> T LazyTime b -> T LazyTime c) -> T LazyTime c)
-> (b -> T LazyTime b -> T LazyTime c) -> T LazyTime c
forall a b. (a -> b) -> a -> b
$ \b
b0 T LazyTime b
bs1 ->
   c -> T LazyTime c -> T LazyTime c
forall body time. body -> T time body -> T time body
EventListMT.consBody (a -> b -> c
f a
a0 b
b0) (T LazyTime c -> T LazyTime c) -> T LazyTime c -> T LazyTime c
forall a b. (a -> b) -> a -> b
$ T StrictTime (Maybe c) -> T LazyTime c
forall y. T StrictTime (Maybe y) -> T LazyTime y
unionMaybe (T StrictTime (Maybe c) -> T LazyTime c)
-> T StrictTime (Maybe c) -> T LazyTime c
forall a b. (a -> b) -> a -> b
$
   (a -> b -> c)
-> a
-> b
-> T StrictTime (Maybe a)
-> T StrictTime (Maybe b)
-> T StrictTime (Maybe c)
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 (T LazyTime a -> T StrictTime (Maybe a)
forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe T LazyTime a
as1) (T LazyTime b -> T StrictTime (Maybe b)
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)
-}