{- |
This module allows abstraction of operations
that operate on the time axis
and do also work on signal types without sample values.
The most distinctive instances are certainly
Dirac signals and chunky time values.
-}
module Synthesizer.Generic.Cut where

import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.FusionList.Signal as SigFL
-- import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy as Vector

import qualified Algebra.ToInteger as ToInteger
import qualified Algebra.Ring as Ring

-- import qualified Number.NonNegative as NonNegW
import qualified Algebra.NonNegative as NonNeg
import qualified Number.NonNegativeChunky as Chunky

-- import qualified Numeric.NonNegative.Wrapper as NonNegW98
import qualified Numeric.NonNegative.Class as NonNeg98
import qualified Numeric.NonNegative.Chunky as Chunky98

import Foreign.Storable (Storable)

import qualified Data.List as List
import Data.Function (fix, )
import Data.Tuple.HT (mapPair, )

import qualified Data.Monoid as Monoid
import Data.Monoid (Monoid, mempty, )

import qualified Prelude as P
import NumericPrelude
import Prelude
   (Bool, Int, String, (++), error,
    pred, (<=), (>=), (<),
    (.), not, (||), (&&), )


class Read sig where
   null :: sig -> Bool
   length :: sig -> Int

class (Read sig, Monoid sig) => Transform sig where
   {- Monoid functions
   empty :: sig
   cycle :: sig -> sig
   append :: sig -> sig -> sig
   concat :: [sig] -> sig
   -}
   take :: Int -> sig -> sig
   drop :: Int -> sig -> sig
   -- can occur in an inner loop in Interpolation
   dropMarginRem :: Int -> Int -> sig -> (Int, sig)
   splitAt :: Int -> sig -> (sig, sig)
   reverse :: sig -> sig


-- instance Storable y => Read SigSt.T y where
instance Storable y => Read (Vector.Vector y) where
   {-# INLINE null #-}
   null = Vector.null
   {-# INLINE length #-}
   length = Vector.length

instance Storable y => Transform (Vector.Vector y) where
   {-
   {-# INLINE empty #-}
   empty = Vector.empty
   {-# INLINE cycle #-}
   cycle = Vector.cycle
   {-# INLINE append #-}
   append = Vector.append
   {-# INLINE concat #-}
   concat = Vector.concat
   -}
   {-# INLINE take #-}
   take = Vector.take
   {-# INLINE drop #-}
   drop = Vector.drop
   {-# INLINE splitAt #-}
   splitAt = Vector.splitAt
   {-# INLINE dropMarginRem #-}
   dropMarginRem = Vector.dropMarginRem
   {-# INLINE reverse #-}
   reverse = Vector.reverse


instance Read ([] y) where
   {-# INLINE null #-}
   null = List.null
   {-# INLINE length #-}
   length = List.length

instance Transform ([] y) where
   {-
   {-# INLINE empty #-}
   empty = []
   {-# INLINE cycle #-}
   cycle = List.cycle
   {-# INLINE append #-}
   append = (List.++)
   {-# INLINE concat #-}
   concat = List.concat
   -}
   {-# INLINE take #-}
   take = List.take
   {-# INLINE drop #-}
   drop = List.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = Sig.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt = List.splitAt
   {-# INLINE reverse #-}
   reverse = List.reverse


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

instance Transform (SigFL.T y) where
   {-
   {-# INLINE empty #-}
   empty = SigFL.empty
   {-# INLINE cycle #-}
   cycle = SigFL.cycle
   {-# INLINE append #-}
   append = SigFL.append
   {-# INLINE concat #-}
   concat = SigFL.concat
   -}

   {-# INLINE take #-}
   take = SigFL.take
   {-# INLINE drop #-}
   drop = SigFL.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = SigFL.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt = SigFL.splitAt
   {-# INLINE reverse #-}
   reverse = SigFL.reverse


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

instance Transform (SigS.T y) where
   {-
   {-# INLINE empty #-}
   empty = SigS.empty
   {-# INLINE cycle #-}
   cycle = SigS.cycle
   {-# INLINE append #-}
   append = SigS.append
   {-# INLINE concat #-}
   concat = SigS.concat
   -}

   {-# INLINE take #-}
   take = SigS.take
   {-# INLINE drop #-}
   drop = SigS.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = SigS.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt n =
      -- This implementation is slow. Better leave it unimplemented?
      mapPair (SigS.fromList, SigS.fromList) .
      List.splitAt n . SigS.toList
   {-# INLINE reverse #-}
   reverse = SigS.reverse


{-
useful for application of non-negative chunky numbers as gate signals
-}
instance (ToInteger.C a, NonNeg.C a) => Read (Chunky.T a) where
   {-# INLINE null #-}
   null = List.null . Chunky.toChunks
   {-# 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


{-# INLINE empty #-}
empty :: (Monoid sig) => sig
empty = Monoid.mempty

{-# INLINE cycle #-}
cycle :: (Monoid sig) => sig -> sig
cycle x = fix (append x)

{-# INLINE append #-}
append :: (Monoid sig) => sig -> sig -> sig
append = Monoid.mappend

{-# INLINE concat #-}
concat :: (Monoid sig) => [sig] -> sig
concat = Monoid.mconcat


{- |
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)