{- |
Functions for cutting signals with respect to lazy chunky time measures.
This is essential for realtime applications.
-}
module Synthesizer.ChunkySize.Cut where

import qualified Synthesizer.ChunkySize as ChunkySize
import qualified Synthesizer.Generic.Cut as Cut
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.State.Signal as SigS

import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy as Vector
import Foreign.Storable (Storable)

import qualified Number.NonNegativeChunky as Chunky

import qualified Data.List.Match as Match
import qualified Data.List as List
import Data.Tuple.HT (mapPair, )
import Data.Monoid (Monoid, )

import NumericPrelude.Numeric
import NumericPrelude.Base hiding (splitAt, Read, )
import Prelude ()


class Cut.Read sig => Read sig where
   length :: sig -> ChunkySize.T

class (Read sig, Monoid sig) => Transform sig where
   take :: ChunkySize.T -> sig -> sig
   drop :: ChunkySize.T -> sig -> sig
   splitAt :: ChunkySize.T -> sig -> (sig, sig)


-- instance Storable y => Read SigSt.T y where
instance Storable y => Read (Vector.Vector y) where
   {-# INLINE length #-}
   length :: Vector y -> T
length = LazySize -> T
ChunkySize.fromStorableVectorSize (LazySize -> T) -> (Vector y -> LazySize) -> Vector y -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector y -> LazySize
forall a. Vector a -> LazySize
SigStV.length

instance Storable y => Transform (Vector.Vector y) where
   {-# INLINE take #-}
   take :: T -> Vector y -> Vector y
take = LazySize -> Vector y -> Vector y
forall a. Storable a => LazySize -> Vector a -> Vector a
SigStV.take (LazySize -> Vector y -> Vector y)
-> (T -> LazySize) -> T -> Vector y -> Vector y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> LazySize
ChunkySize.toStorableVectorSize
   {-# INLINE drop #-}
   drop :: T -> Vector y -> Vector y
drop = LazySize -> Vector y -> Vector y
forall a. Storable a => LazySize -> Vector a -> Vector a
SigStV.drop (LazySize -> Vector y -> Vector y)
-> (T -> LazySize) -> T -> Vector y -> Vector y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> LazySize
ChunkySize.toStorableVectorSize
   {-# INLINE splitAt #-}
   splitAt :: T -> Vector y -> (Vector y, Vector y)
splitAt = LazySize -> Vector y -> (Vector y, Vector y)
forall a.
Storable a =>
LazySize -> Vector a -> (Vector a, Vector a)
SigStV.splitAt (LazySize -> Vector y -> (Vector y, Vector y))
-> (T -> LazySize) -> T -> Vector y -> (Vector y, Vector y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> LazySize
ChunkySize.toStorableVectorSize


instance Read ([] y) where
   {-# INLINE length #-}
   length :: [y] -> T
length [y]
xs =
      [LazySize] -> T
forall a. C a => [a] -> T a
Chunky.fromChunks ([LazySize] -> T) -> [LazySize] -> T
forall a b. (a -> b) -> a -> b
$ [y] -> LazySize -> [LazySize]
forall a b. [a] -> b -> [b]
Match.replicate [y]
xs (LazySize -> [LazySize]) -> LazySize -> [LazySize]
forall a b. (a -> b) -> a -> b
$ Int -> LazySize
SigG.LazySize Int
forall a. C a => a
one

instance Transform ([] y) where
   {-# INLINE take #-}
   take :: T -> [y] -> [y]
take T
ns =
      [()] -> [y] -> [y]
forall b a. [b] -> [a] -> [a]
Match.take (T -> [()]
ChunkySize.toNullList T
ns)
   {-# INLINE drop #-}
   drop :: T -> [y] -> [y]
drop T
ns [y]
xs =
      -- 'drop' cannot make much use of laziness, thus 'foldl' is ok
      ([y] -> LazySize -> [y]) -> [y] -> [LazySize] -> [y]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl
         (\[y]
x (SigG.LazySize Int
n) -> Int -> [y] -> [y]
forall a. Int -> [a] -> [a]
List.drop Int
n [y]
x)
         [y]
xs (T -> [LazySize]
forall a. C a => T a -> [a]
Chunky.toChunks T
ns)
   {-# INLINE splitAt #-}
   splitAt :: T -> [y] -> ([y], [y])
splitAt T
ns =
      [()] -> [y] -> ([y], [y])
forall b a. [b] -> [a] -> ([a], [a])
Match.splitAt (T -> [()]
ChunkySize.toNullList T
ns)

{-
instance Read (SigFL.T y) where
   {-# INLINE length #-}
   length = SigFL.length

instance Transform (SigFL.T y) where
   {-# INLINE take #-}
   take = SigFL.take
   {-# INLINE drop #-}
   drop = SigFL.drop
   {-# INLINE splitAt #-}
   splitAt = SigFL.splitAt
-}

instance Read (SigS.T y) where
   {-# INLINE length #-}
   length :: T y -> T
length =
      [LazySize] -> T
forall a. C a => [a] -> T a
Chunky.fromChunks ([LazySize] -> T) -> (T y -> [LazySize]) -> T y -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T LazySize -> [LazySize]
forall y. T y -> [y]
SigS.toList (T LazySize -> [LazySize])
-> (T y -> T LazySize) -> T y -> [LazySize]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (y -> LazySize) -> T y -> T LazySize
forall a b. (a -> b) -> T a -> T b
SigS.map (LazySize -> y -> LazySize
forall a b. a -> b -> a
const (Int -> LazySize
SigG.LazySize Int
forall a. C a => a
one))

instance Transform (SigS.T y) where
   {-# INLINE take #-}
   take :: T -> T y -> T y
take T
size0 =
      (y -> (Int, [LazySize]) -> Maybe (y, (Int, [LazySize])))
-> (Int, [LazySize]) -> T y -> T y
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
SigS.crochetL
         (\y
x (Int
n,[LazySize]
ns) ->
            if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
forall a. C a => a
zero
              then (y, (Int, [LazySize])) -> Maybe (y, (Int, [LazySize]))
forall a. a -> Maybe a
Just (y
x, (Int -> Int
forall a. Enum a => a -> a
pred Int
n, [LazySize]
ns))
              else
                case [LazySize]
ns of
                  SigG.LazySize Int
m : [LazySize]
ms -> (y, (Int, [LazySize])) -> Maybe (y, (Int, [LazySize]))
forall a. a -> Maybe a
Just (y
x, (Int -> Int
forall a. Enum a => a -> a
pred Int
m, [LazySize]
ms))
                  [] -> Maybe (y, (Int, [LazySize]))
forall a. Maybe a
Nothing)
         (Int
forall a. C a => a
zero, T -> [LazySize]
forall a. C a => T a -> [a]
Chunky.toChunks (T -> [LazySize]) -> T -> [LazySize]
forall a b. (a -> b) -> a -> b
$ T -> T
forall a. C a => T a -> T a
Chunky.normalize T
size0)
   {-# INLINE drop #-}
   drop :: T -> T y -> T y
drop T
ns T y
xs =
      (T y -> LazySize -> T y) -> T y -> [LazySize] -> T y
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl
         (\T y
x (SigG.LazySize Int
n) -> Int -> T y -> T y
forall a. Int -> T a -> T a
SigS.drop Int
n T y
x)
         T y
xs (T -> [LazySize]
forall a. C a => T a -> [a]
Chunky.toChunks T
ns)
   {-# INLINE splitAt #-}
   splitAt :: T -> T y -> (T y, T y)
splitAt T
n =
      -- This implementation is slow. Better leave it unimplemented?
      ([y] -> T y, [y] -> T y) -> ([y], [y]) -> (T y, T y)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ([y] -> T y
forall y. [y] -> T y
SigS.fromList, [y] -> T y
forall y. [y] -> T y
SigS.fromList) (([y], [y]) -> (T y, T y))
-> (T y -> ([y], [y])) -> T y -> (T y, T y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      T -> [y] -> ([y], [y])
forall sig. Transform sig => T -> sig -> (sig, sig)
splitAt T
n ([y] -> ([y], [y])) -> (T y -> [y]) -> T y -> ([y], [y])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> [y]
forall y. T y -> [y]
SigS.toList


{-
{-
useful for application of non-negative chunky numbers as gate signals
-}
instance (ToInteger.C a, NonNeg.C a) => Read (Chunky.T a) where
   {-# INLINE length #-}
   length = sum . List.map (fromIntegral . toInteger) . Chunky.toChunks


intToChunky :: (Ring.C a, NonNeg.C a) => String -> Int -> Chunky.T a
intToChunky name =
   Chunky.fromNumber .
-- the non-negative type is not necessarily a wrapper
--   NonNegW.fromNumberMsg ("Generic.Cut."++name) .
   fromIntegral .
   (\x ->
      if x<zero
        then error ("Generic.Cut.NonNeg.Chunky."++name++": negative argument")
        else x)


instance (ToInteger.C a, NonNeg.C a) => Transform (Chunky.T a) where
   {-# INLINE take #-}
   take n = P.min (intToChunky "take" n)
   {-# INLINE drop #-}
   drop n x = x NonNeg.-| intToChunky "drop" n
   {-# INLINE dropMarginRem #-}
   dropMarginRem n m x =
      let (z,d,b) =
             Chunky.minMaxDiff
                (intToChunky "dropMargin/n" n)
                (x NonNeg.-| intToChunky "dropMargin/m" m)
      in  (if b then 0 else fromIntegral (Chunky.toNumber d),
           x NonNeg.-| z)
   {-# INLINE splitAt #-}
   splitAt n x =
      let (z,d,b) = Chunky.minMaxDiff (intToChunky "splitAt" n) x
      in  (z, if b then d else mempty)
   {-# INLINE reverse #-}
   reverse = Chunky.fromChunks . List.reverse . Chunky.toChunks



instance (P.Integral a) => Read (Chunky98.T a) where
   {-# INLINE null #-}
   null = List.null . Chunky98.toChunks
   {-# INLINE length #-}
   length = sum . List.map (P.fromIntegral . P.toInteger) . Chunky98.toChunks


intToChunky98 :: (NonNeg98.C a) => String -> Int -> Chunky98.T a
intToChunky98 name =
   Chunky98.fromNumber .
--   NonNegW.fromNumberMsg ("Generic.Cut."++name) .
   P.fromIntegral .
   (\x ->
      if x<0
        then error ("Generic.Cut.NonNeg.Chunky98."++name++": negative argument")
        else x)

instance (P.Integral a, NonNeg98.C a) => Transform (Chunky98.T a) where
   {-# INLINE take #-}
   take n = P.min (intToChunky98 "take" n)
   {-# INLINE drop #-}
   drop n x = x NonNeg98.-| intToChunky98 "drop" n
   {-# INLINE dropMarginRem #-}
   dropMarginRem n m x =
      let (z,d,b) =
             Chunky98.minMaxDiff
                (intToChunky98 "dropMargin/n" n)
                (x NonNeg98.-| intToChunky98 "dropMargin/m" m)
      in  (if b then 0 else P.fromIntegral (Chunky98.toNumber d),
           x NonNeg98.-| z)
   {-# INLINE splitAt #-}
   splitAt n x =
      let (z,d,b) = Chunky98.minMaxDiff (intToChunky98 "splitAt" n) x
      in  (z, if b then d else Chunky98.zero)
   {-# INLINE reverse #-}
   reverse = Chunky98.fromChunks . List.reverse . Chunky98.toChunks


{- |
Like @lengthAtLeast n xs  =  length xs >= n@,
but is more efficient, because it is more lazy.
-}
{-# INLINE lengthAtLeast #-}
lengthAtLeast :: (Transform sig) =>
   Int -> sig -> Bool
lengthAtLeast n xs =
   n<=0 || not (null (drop (pred n) xs))

{-# INLINE lengthAtMost #-}
lengthAtMost :: (Transform sig) =>
   Int -> sig -> Bool
lengthAtMost n xs =
   n>=0 && null (drop n xs)

{-# INLINE sliceVertical #-}
sliceVertical :: (Transform sig) =>
   Int -> sig -> SigS.T sig
sliceVertical n =
   SigS.map (take n) .
   SigS.takeWhile (not . null) .
   SigS.iterate (drop n)
-}