module Synthesizer.Storable.Cut where

import qualified Synthesizer.Storable.Signal as Sig

import qualified Data.StorableVector           as SV
import qualified Data.StorableVector.Lazy      as SVL
import qualified Data.StorableVector.ST.Strict as SVST

import Control.Monad.ST.Strict (ST, runST, )

import qualified Data.EventList.Relative.TimeBody  as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
import Control.Monad.Trans.State (runState, modify, gets, put, )
-- import Control.Monad (mapM, )
import Data.Tuple.HT (mapSnd, )

-- import qualified Algebra.Real     as Real
import qualified Algebra.Additive as Additive
import qualified Number.NonNegative as NonNeg

import Foreign.Storable (Storable)

import PreludeBase
import NumericPrelude


{-# INLINE arrange #-}
arrange :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrange =
   arrangeEquidist

{- |
Chunk sizes are adapted to the time differences.
Explicit ChunkSize parameter is only required for zero padding.
Since no ST monad is needed, this can be generalized to Generic.Signal.Transform class.
-}
arrangeAdaptive :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeAdaptive size =
   uncurry Sig.append .
   flip runState Sig.empty .
   fmap (Sig.concat . EventList.getTimes) .
   EventList.mapM
      (\timeNN ->
           let time = NonNeg.toNumber timeNN
           in  do (prefix,suffix) <- gets (Sig.splitAtPad size time)
                  put suffix
                  return prefix)
      (\body ->
           modify (Sig.mixSndPattern body))


arrangeList :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeList size evs =
   let xs = EventList.getBodies evs
   in  case EventList.getTimes evs of
          t:ts -> Sig.replicate size (NonNeg.toNumber t) zero `Sig.append`
                  addShiftedMany size ts xs
          []   -> Sig.empty


addShiftedMany :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> [NonNeg.Int] -> [Sig.T a] -> Sig.T a
addShiftedMany size ds xss =
   foldr (uncurry (addShifted size)) Sig.empty (zip (ds++[0]) xss)


{-
It is crucial that 'mix' uses the chunk size structure of the second operand.
This way we avoid unnecessary and even infinite look-ahead.
-}
addShifted :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> NonNeg.Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted size delNN px py =
   let del = NonNeg.toNumber delNN
   in  uncurry Sig.append $
       mapSnd (flip Sig.mixSndPattern py) $
       Sig.splitAtPad size del px


{-
arrangeEquidist (Sig.chunkSize 2) (EventList.fromPairList [(10, SVL.pack SVL.defaultChunkSize [1..8::Double]), (2, SVL.pack (Sig.chunkSize 2) $ [4,3,2,1::Double] ++ undefined)])
-}
{- |
The result is a Lazy StorableVector with chunks of the given size.
-}
{-# INLINE arrangeEquidist #-}
arrangeEquidist :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeEquidist (SVL.ChunkSize sz) =
   let sznn = NonNeg.fromNumberMsg "arrangeEquidist" sz
       go acc evs =
          let (now,future) = EventListTM.splitAtTime sznn evs
              xs =
                 AbsEventList.toPairList $
                 EventList.toAbsoluteEventList 0 $
                 EventListTM.switchTimeR const now
              (chunk,newAcc) =
                 runST
                    (do v <- SVST.new sz zero
                        newAcc0 <- mapM (addToBuffer v 0) acc
--                        newAcc1 <- AbsEventList.mapM (addToBuffer v) xs
                        newAcc1 <-
                           mapM (\(i,s) -> addToBuffer v (NonNeg.toNumber i) s) xs
                        vf <- SVST.freeze v
                        return (vf, newAcc0++newAcc1))
              (ends, suffixes) = unzip $ newAcc
              prefix =
                 {- if there are more events to come,
                    we must pad with zeros -}
                 if EventList.null future
                   then SV.take (foldl max 0 ends) chunk
                   else chunk
          in  if SV.null prefix
                then []
                else prefix : go (filter (not . Sig.null) suffixes) future
   in  Sig.fromChunks . go []


{-
{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer v start =
   let n = SVST.length v
       go i [] = return (i, [])
       go i (c:cs) =
          let end = i + SV.length c
          in  addChunkToBuffer v i c >>
              if end<n
                then go end cs
                else return (n, SV.drop (end-n) c : cs)
   in  fmap (mapSnd SigSt.fromChunks) . go start . SigSt.chunks

addChunkToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer v start xs =
   let n = SVST.length v
   in  SV.foldr
          (\x continue i ->
             SVST.modify v i (x Additive.+) >>
             continue (succ i))
          (\_i -> return ())
          (Sig.take (n Additive.- start) xs)
          start
-}

{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer v start xs =
   let n = SVST.length v
       (now,future) = Sig.splitAt (n Additive.- start) xs
       go i [] = return i
       go i (c:cs) =
          addChunkToBuffer v i c >>
          go (i Additive.+ SV.length c) cs
   in  fmap (flip (,) future) . go start . Sig.chunks $ now

{- chunk must fit into the buffer -}
{-# INLINE addChunkToBuffer #-}
addChunkToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer v start xs =
   SV.foldr
      (\x continue i ->
         SVST.unsafeModify v i (x Additive.+) >>
         continue (succ i))
      (\_i -> return ())
      xs start


{-# INLINE addToBufferFoldr #-}
addToBufferFoldr :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBufferFoldr v start xs =
   let n = SVST.length v
       (now,future) = Sig.splitAt (n Additive.- start) xs
   in  Sig.foldr
          (\x continue i ->
             SVST.modify v i (x Additive.+) >>
             continue (succ i))
          (\i -> return (i, future))
          now start


{-
Using @Sig.switchL@ in an inner loop
is slower than using @Sig.foldr@.
Using a StorableVectorPointer would be faster,
but I think still slower than @foldr@.
-}
addToBufferSwitchL :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBufferSwitchL v start =
   let n = SVST.length v
       {-# INLINE go #-}
       go i =
          if i>=n
            then return . (,) i
            else
              Sig.switchL
                 (return (i, Sig.empty))
                 (\x xs ->
                     SVST.modify v i (x Additive.+) >>
                     go (succ i) xs)
   in  go start