{- |
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 Data.StorableVector as SV
import qualified Data.StorableVector.Lazy as SVL

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

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

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

import qualified Numeric.NonNegative.Class as NonNeg98
import qualified Numeric.NonNegative.Chunky as Chunky98

import Foreign.Storable (Storable, )
import Control.DeepSeq (NFData, rnf, )

import qualified Data.List.HT as ListHT
import qualified Data.List as List
import qualified Data.Monoid as Monoid
import Data.Function (fix, )
import Data.Tuple.HT (mapPair, mapFst, mapSnd, )
import Data.Monoid (Monoid, mempty, )

import qualified Prelude as P
import NumericPrelude.Numeric
import Prelude
   (Bool, String, (++), error,
    pred, (==), (<=), (>=), (<),
    (.), ($), const, snd,
    not, (||), (&&), min, max, )


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

class (Read sig) => NormalForm sig where
   {- |
   Evaluating the first value of the signal
   is necessary for avoiding a space leaks
   if you repeatedly drop a prefix from the signal
   and do not consume something from it.
   -}
   evaluateHead :: sig -> ()

class (Read sig, Monoid sig) => Transform sig where
   {- Monoid functions
   {-
   In our categorization 'empty' would belong to the Write class,
   but since an empty signal contains no data,
   the maximum packet size is irrelevant.
   This makes e.g. the definition of mixMulti more general.
   -}
   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 (SV.Vector y) where
   {-# INLINE null #-}
   null :: Vector y -> Bool
null = Vector y -> Bool
forall a. Vector a -> Bool
SV.null
   {-# INLINE length #-}
   length :: Vector y -> Int
length = Vector y -> Int
forall a. Vector a -> Int
SV.length

instance (Storable y) => NormalForm (SV.Vector y) where
   {-# INLINE evaluateHead #-}
   evaluateHead :: Vector y -> ()
evaluateHead Vector y
x =
      if Vector y -> Bool
forall a. Vector a -> Bool
SV.null Vector y
x then () else ()

instance Storable y => Transform (SV.Vector y) where
   {-# INLINE take #-}
   take :: Int -> Vector y -> Vector y
take = Int -> Vector y -> Vector y
forall y. Storable y => Int -> Vector y -> Vector y
SV.take
   {-# INLINE drop #-}
   drop :: Int -> Vector y -> Vector y
drop = Int -> Vector y -> Vector y
forall y. Storable y => Int -> Vector y -> Vector y
SV.drop
   {-# INLINE splitAt #-}
   splitAt :: Int -> Vector y -> (Vector y, Vector y)
splitAt = Int -> Vector y -> (Vector y, Vector y)
forall y. Storable y => Int -> Vector y -> (Vector y, Vector y)
SV.splitAt
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> Vector y -> (Int, Vector y)
dropMarginRem Int
n Int
m Vector y
xs =
      let d :: Int
d = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Vector y -> Int
forall a. Vector a -> Int
SV.length Vector y
xs Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
n
      in  (Int
mInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
d, Int -> Vector y -> Vector y
forall y. Storable y => Int -> Vector y -> Vector y
SV.drop Int
d Vector y
xs)
   {-# INLINE reverse #-}
   reverse :: Vector y -> Vector y
reverse = Vector y -> Vector y
forall y. Storable y => Vector y -> Vector y
SV.reverse


-- instance Storable y => Read SigSt.T y where
instance Storable y => Read (SVL.Vector y) where
   {-# INLINE null #-}
   null :: Vector y -> Bool
null = Vector y -> Bool
forall y. Storable y => Vector y -> Bool
SVL.null
   {-# INLINE length #-}
   length :: Vector y -> Int
length = Vector y -> Int
forall a. Vector a -> Int
SVL.length

instance (Storable y) => NormalForm (SVL.Vector y) where
   {-# INLINE evaluateHead #-}
   evaluateHead :: Vector y -> ()
evaluateHead =
      () -> (Vector y -> [Vector y] -> ()) -> [Vector y] -> ()
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL () (\Vector y
x [Vector y]
_ -> Vector y -> ()
forall sig. NormalForm sig => sig -> ()
evaluateHead Vector y
x) ([Vector y] -> ()) -> (Vector y -> [Vector y]) -> Vector y -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector y -> [Vector y]
forall a. Vector a -> [Vector a]
SVL.chunks
--      ListHT.switchL () (\x _ -> rnf x) . SVL.chunks
--   evaluateHead x =
--      if SVL.null x then () else ()

{-
instance (Storable y, NFData y) => NormalForm (SVL.Vector y) where
   {-# INLINE evaluateHead #-}
   evaluateHead x = SVL.switchL () (\x _ -> rnf x)
-}

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


instance Read ([] y) where
   {-# INLINE null #-}
   null :: [y] -> Bool
null = [y] -> Bool
forall y. [y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null
   {-# INLINE length #-}
   length :: [y] -> Int
length = [y] -> Int
forall y. [y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length

instance (NFData y) => NormalForm ([] y) where
   {-# INLINE evaluateHead #-}
   evaluateHead :: [y] -> ()
evaluateHead = () -> (y -> [y] -> ()) -> [y] -> ()
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL () (\y
x [y]
_ -> y -> ()
forall a. NFData a => a -> ()
rnf y
x)

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


instance Read (SigS.T y) where
   {-# INLINE null #-}
   null :: T y -> Bool
null = T y -> Bool
forall y. T y -> Bool
SigS.null
   {-# INLINE length #-}
   length :: T y -> Int
length = T y -> Int
forall y. T y -> Int
SigS.length

instance (NFData y) => NormalForm (SigS.T y) where
   {-
   Evaluating the first element of a generator might look silly,
   since it is not stored in a data structure.
   However, the generator depends on an internal state,
   which might be in turn a list or a storable vector,
   which is evaluated then.
   -}
   {-# INLINE evaluateHead #-}
   evaluateHead :: T y -> ()
evaluateHead = () -> (y -> T y -> ()) -> T y -> ()
forall b a. b -> (a -> T a -> b) -> T a -> b
SigS.switchL () (\y
x T y
_ -> y -> ()
forall a. NFData a => a -> ()
rnf y
x)

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 :: Int -> T y -> T y
take = Int -> T y -> T y
forall y. Int -> T y -> T y
SigS.take
   {-# INLINE drop #-}
   drop :: Int -> T y -> T y
drop = Int -> T y -> T y
forall y. Int -> T y -> T y
SigS.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> T y -> (Int, T y)
dropMarginRem = Int -> Int -> T y -> (Int, T y)
forall y. Int -> Int -> T y -> (Int, T y)
SigS.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt :: Int -> T y -> (T y, T y)
splitAt Int
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
.
      Int -> [y] -> ([y], [y])
forall y. Int -> [y] -> ([y], [y])
List.splitAt Int
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
   {-# INLINE reverse #-}
   reverse :: T y -> T y
reverse = T y -> T y
forall y. T y -> T y
SigS.reverse


{- |
We abuse event lists for efficient representation of piecewise constant signals.
-}
instance (P.Integral t) => Read (EventList.T t y) where
   null :: T t y -> Bool
null = T t y -> Bool
forall time body. T time body -> Bool
EventList.null
   length :: T t y -> Int
length = Integer -> Int
forall a b. (C a, C b) => a -> b
fromIntegral (Integer -> Int) -> (T t y -> Integer) -> T t y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Integer
forall a. Integral a => a -> Integer
P.toInteger (t -> Integer) -> (T t y -> t) -> T t y -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> t
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
P.sum ([t] -> t) -> (T t y -> [t]) -> T t y -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t y -> [t]
forall time body. T time body -> [time]
EventList.getTimes

instance (P.Integral t, NFData y) => NormalForm (EventList.T t y) where
   evaluateHead :: T t y -> ()
evaluateHead = () -> (y -> t -> T t y -> ()) -> T t y -> ()
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL () (\y
x t
_ T t y
_ -> y -> ()
forall a. NFData a => a -> ()
rnf y
x)


{-
needed for chunks of MIDI events as input to CausalIO processes
-}
instance (P.Integral t) => Read (EventListTT.T t y) where
   null :: T t y -> Bool
null = (t -> T t y -> Bool) -> T t y -> Bool
forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL (\t
t T t y
xs -> t
tt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
0 Bool -> Bool -> Bool
&& T t y -> Bool
forall time body. T time body -> Bool
EventList.null T t y
xs)
   length :: T t y -> Int
length = Integer -> Int
forall a b. (C a, C b) => a -> b
fromIntegral (Integer -> Int) -> (T t y -> Integer) -> T t y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Integer
forall a. Integral a => a -> Integer
P.toInteger (t -> Integer) -> (T t y -> t) -> T t y -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> t
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
P.sum ([t] -> t) -> (T t y -> [t]) -> T t y -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t y -> [t]
forall time body. T time body -> [time]
EventListTT.getTimes

instance (P.Integral t, NonNeg98.C t) => Transform (EventListTT.T t y) where
   take :: Int -> T t y -> T t y
take = t -> T t y -> T t y
forall time body. C time => time -> T time body -> T time body
EventListTT.takeTime (t -> T t y -> T t y) -> (Int -> t) -> Int -> T t y -> T t y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
   drop :: Int -> T t y -> T t y
drop = t -> T t y -> T t y
forall time body. C time => time -> T time body -> T time body
EventListTT.dropTime (t -> T t y -> T t y) -> (Int -> t) -> Int -> T t y -> T t y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
   dropMarginRem :: Int -> Int -> T t y -> (Int, T t y)
dropMarginRem =
      (T t y -> [Int]) -> Int -> Int -> T t y -> (Int, T t y)
forall sig.
Transform sig =>
(sig -> [Int]) -> Int -> Int -> sig -> (Int, sig)
dropMarginRemChunky ((t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
P.map t -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral ([t] -> [Int]) -> (T t y -> [t]) -> T t y -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t y -> [t]
forall time body. T time body -> [time]
EventListTT.getTimes)
   splitAt :: Int -> T t y -> (T t y, T t y)
splitAt = t -> T t y -> (T t y, T t y)
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
EventListTT.splitAtTime (t -> T t y -> (T t y, T t y))
-> (Int -> t) -> Int -> T t y -> (T t y, T t y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
   reverse :: T t y -> T t y
reverse = T t y -> T t y
forall time body. T time body -> T time body
EventListTT.reverse


-- cf. StorableVector.Lazy.dropMarginRem
dropMarginRemChunky ::
   (Transform sig) =>
   (sig -> [Int]) -> Int -> Int -> sig -> (Int, sig)
dropMarginRemChunky :: forall sig.
Transform sig =>
(sig -> [Int]) -> Int -> Int -> sig -> (Int, sig)
dropMarginRemChunky sig -> [Int]
getTimes Int
n Int
m sig
xs =
   ((Int, sig) -> Int -> (Int, sig))
-> (Int, sig) -> [Int] -> (Int, sig)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
      (\(Int
mi,sig
xsi) Int
k -> (Int
miInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
k, Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
drop Int
k sig
xsi))
      (Int
m, sig
xs)
      (sig -> [Int]
getTimes (sig -> [Int]) -> sig -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
take Int
m (sig -> sig) -> sig -> sig
forall a b. (a -> b) -> a -> b
$ Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
drop Int
n sig
xs)

{- |
The function defined here are based on the interpretation
of event lists as piecewise constant signals.
They do not fit to the interpretation of atomic events.
Because e.g. it makes no sense to split an atomic event into two instances by splitAt,
and it is also not clear, whether dropping the first chunk
shall leave a chunk of length zero
or remove that chunk completely.

However, sometimes we also need lists of events.
In this case the 'reverse' method would be different.
For an event-oriented instance of EventList.TimeTime
see NoteOffList in synthesizer-alsa package.
-}
instance (P.Integral t, NonNeg98.C t) => Transform (EventList.T t y) where
   take :: Int -> T t y -> T t y
take Int
n T t y
xs =
      (y -> t -> (t -> T t y) -> t -> T t y)
-> (t -> T t y) -> T t y -> t -> T t y
forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventList.foldrPair
         (\y
b t
t t -> T t y
go t
remain ->
            if t
remain t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
forall a. C a => a
NonNeg98.zero
              then T t y
forall time body. T time body
EventList.empty
              else
                let (t
m, ~(Bool
le,t
d)) = t -> t -> (t, (Bool, t))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg98.split t
t t
remain
                in  y -> t -> T t y -> T t y
forall body time. body -> time -> T time body -> T time body
EventList.cons y
b t
m (T t y -> T t y) -> T t y -> T t y
forall a b. (a -> b) -> a -> b
$
                    t -> T t y
go (if Bool
le then t
d else t
forall a. C a => a
NonNeg98.zero))
         (T t y -> t -> T t y
forall a b. a -> b -> a
const T t y
forall time body. T time body
EventList.empty) T t y
xs
         (Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral Int
n)

   drop :: Int -> T t y -> T t y
drop =
      let recourse :: time -> T time body -> T time body
recourse time
n =
             T time body
-> (body -> time -> T time body -> T time body)
-> T time body
-> T time body
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL T time body
forall time body. T time body
EventList.empty ((body -> time -> T time body -> T time body)
 -> T time body -> T time body)
-> (body -> time -> T time body -> T time body)
-> T time body
-> T time body
forall a b. (a -> b) -> a -> b
$ \body
b time
t T time body
xs ->
             let (Bool
le,time
d) = (time, (Bool, time)) -> (Bool, time)
forall a b. (a, b) -> b
snd ((time, (Bool, time)) -> (Bool, time))
-> (time, (Bool, time)) -> (Bool, time)
forall a b. (a -> b) -> a -> b
$ time -> time -> (time, (Bool, time))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg98.split time
t time
n
             in  if Bool
le
                   then time -> T time body -> T time body
recourse time
d T time body
xs
                   else body -> time -> T time body -> T time body
forall body time. body -> time -> T time body -> T time body
EventList.cons body
b time
d T time body
xs
      in  t -> T t y -> T t y
forall {time} {body}. C time => time -> T time body -> T time body
recourse (t -> T t y -> T t y) -> (Int -> t) -> Int -> T t y -> T t y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

   dropMarginRem :: Int -> Int -> T t y -> (Int, T t y)
dropMarginRem =
      (T t y -> [Int]) -> Int -> Int -> T t y -> (Int, T t y)
forall sig.
Transform sig =>
(sig -> [Int]) -> Int -> Int -> sig -> (Int, sig)
dropMarginRemChunky ((t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
P.map t -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral ([t] -> [Int]) -> (T t y -> [t]) -> T t y -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t y -> [t]
forall time body. T time body -> [time]
EventList.getTimes)

   -- cf. StorableVector.Lazy.splitAt
   splitAt :: Int -> T t y -> (T t y, T t y)
splitAt =
      let recourse :: t -> T t body -> (T t body, T t body)
recourse t
0 = (,) T t body
forall time body. T time body
EventList.empty
          recourse t
n =
             (T t body, T t body)
-> (body -> t -> T t body -> (T t body, T t body))
-> T t body
-> (T t body, T t body)
forall c body time.
c -> (body -> time -> T time body -> c) -> T time body -> c
EventList.switchL (T t body
forall time body. T time body
EventList.empty, T t body
forall time body. T time body
EventList.empty) ((body -> t -> T t body -> (T t body, T t body))
 -> T t body -> (T t body, T t body))
-> (body -> t -> T t body -> (T t body, T t body))
-> T t body
-> (T t body, T t body)
forall a b. (a -> b) -> a -> b
$ \body
b t
t T t body
xs ->
             let (t
m, ~(Bool
le,t
d)) = t -> t -> (t, (Bool, t))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg98.split t
t t
n
             in  (T t body -> T t body)
-> (T t body, T t body) -> (T t body, T t body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (body -> t -> T t body -> T t body
forall body time. body -> time -> T time body -> T time body
EventList.cons body
b t
m) ((T t body, T t body) -> (T t body, T t body))
-> (T t body, T t body) -> (T t body, T t body)
forall a b. (a -> b) -> a -> b
$
                 if Bool
le
                   then t -> T t body -> (T t body, T t body)
recourse t
d T t body
xs
                   else (T t body
forall time body. T time body
EventList.empty, body -> t -> T t body -> T t body
forall body time. body -> time -> T time body -> T time body
EventList.cons body
b t
d T t body
xs)
      in  t -> T t y -> (T t y, T t y)
forall {t} {body}.
(Num t, C t) =>
t -> T t body -> (T t body, T t body)
recourse (t -> T t y -> (T t y, T t y))
-> (Int -> t) -> Int -> T t y -> (T t y, T t y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

   reverse :: T t y -> T t y
reverse =
      [(y, t)] -> T t y
forall body time. [(body, time)] -> T time body
EventList.fromPairList ([(y, t)] -> T t y) -> (T t y -> [(y, t)]) -> T t y -> T t y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(y, t)] -> [(y, t)]
forall y. [y] -> [y]
List.reverse ([(y, t)] -> [(y, t)]) -> (T t y -> [(y, t)]) -> T t y -> [(y, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t y -> [(y, t)]
forall time body. T time body -> [(body, time)]
EventList.toPairList


{-
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 :: T a -> Bool
null = [a] -> Bool
forall y. [y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([a] -> Bool) -> (T a -> [a]) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
Chunky.toChunks
   {-# INLINE length #-}
   length :: T a -> Int
length = [Int] -> Int
forall a. C a => [a] -> a
sum ([Int] -> Int) -> (T a -> [Int]) -> T a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
List.map (Integer -> Int
forall a b. (C a, C b) => a -> b
fromIntegral (Integer -> Int) -> (a -> Integer) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. C a => a -> Integer
toInteger) ([a] -> [Int]) -> (T a -> [a]) -> T a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
Chunky.toChunks

instance (ToInteger.C a, NonNeg.C a, NFData a) => NormalForm (Chunky.T a) where
   {-# INLINE evaluateHead #-}
   evaluateHead :: T a -> ()
evaluateHead = () -> (a -> [a] -> ()) -> [a] -> ()
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL () (\a
x [a]
_ -> a -> ()
forall a. NFData a => a -> ()
rnf a
x) ([a] -> ()) -> (T a -> [a]) -> T a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
Chunky.toChunks


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


instance (ToInteger.C a, NonNeg.C a) => Transform (Chunky.T a) where
   {-# INLINE take #-}
   take :: Int -> T a -> T a
take Int
n = T a -> T a -> T a
forall a. Ord a => a -> a -> a
P.min (String -> Int -> T a
forall a. (C a, C a) => String -> Int -> T a
intToChunky String
"take" Int
n)
   {-# INLINE drop #-}
   drop :: Int -> T a -> T a
drop Int
n T a
x = T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg.-| String -> Int -> T a
forall a. (C a, C a) => String -> Int -> T a
intToChunky String
"drop" Int
n
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem Int
n Int
m T a
x =
      let (T a
z,~(Bool
b,T a
d)) =
             T a -> T a -> (T a, (Bool, T a))
forall a. C a => T a -> T a -> (T a, (Bool, T a))
Chunky.minMaxDiff
                (String -> Int -> T a
forall a. (C a, C a) => String -> Int -> T a
intToChunky String
"dropMargin/n" Int
m)
                (T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg.-| String -> Int -> T a
forall a. (C a, C a) => String -> Int -> T a
intToChunky String
"dropMargin/m" Int
n)
      in  (if Bool
b then Int
0 else a -> Int
forall a b. (C a, C b) => a -> b
fromIntegral (T a -> a
forall a. C a => T a -> a
Chunky.toNumber T a
d),
           T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg.-| T a
z)
   {-# INLINE splitAt #-}
   splitAt :: Int -> T a -> (T a, T a)
splitAt Int
n T a
x =
      ((Bool, T a) -> T a) -> (T a, (Bool, T a)) -> (T a, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd
         (\ ~(Bool
b,T a
d) -> if Bool
b then T a
d else T a
forall a. Monoid a => a
mempty)
         (T a -> T a -> (T a, (Bool, T a))
forall a. C a => T a -> T a -> (T a, (Bool, T a))
Chunky.minMaxDiff (String -> Int -> T a
forall a. (C a, C a) => String -> Int -> T a
intToChunky String
"splitAt" Int
n) T a
x)
   {-# INLINE reverse #-}
   reverse :: T a -> T a
reverse = [a] -> T a
forall a. C a => [a] -> T a
Chunky.fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall y. [y] -> [y]
List.reverse ([a] -> [a]) -> (T a -> [a]) -> T a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
Chunky.toChunks



instance (P.Integral a) => Read (Chunky98.T a) where
   {-# INLINE null #-}
   null :: T a -> Bool
null = [a] -> Bool
forall y. [y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([a] -> Bool) -> (T a -> [a]) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks
   {-# INLINE length #-}
   length :: T a -> Int
length = [Int] -> Int
forall a. C a => [a] -> a
sum ([Int] -> Int) -> (T a -> [Int]) -> T a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
List.map (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Integer -> Int) -> (a -> Integer) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
P.toInteger) ([a] -> [Int]) -> (T a -> [a]) -> T a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks

instance (P.Integral a, NonNeg.C a, NFData a) =>
      NormalForm (Chunky98.T a) where
   {-# INLINE evaluateHead #-}
   evaluateHead :: T a -> ()
evaluateHead = () -> (a -> [a] -> ()) -> [a] -> ()
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL () (\a
x [a]
_ -> a -> ()
forall a. NFData a => a -> ()
rnf a
x) ([a] -> ()) -> (T a -> [a]) -> T a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks


intToChunky98 :: (P.Num a, NonNeg98.C a) => String -> Int -> Chunky98.T a
intToChunky98 :: forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
name =
   a -> T a
forall a. C a => a -> T a
Chunky98.fromNumber (a -> T a) -> (Int -> a) -> Int -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
--   NonNegW.fromNumberMsg ("Generic.Cut."++name) .
   Int -> a
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (\Int
x ->
      if Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
        then String -> Int
forall a. HasCallStack => String -> a
error (String
"Generic.Cut.NonNeg.Chunky98."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": negative argument")
        else Int
x)

instance (P.Integral a, NonNeg98.C a) => Transform (Chunky98.T a) where
   {-# INLINE take #-}
   take :: Int -> T a -> T a
take Int
n = T a -> T a -> T a
forall a. Ord a => a -> a -> a
P.min (String -> Int -> T a
forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
"take" Int
n)
   {-# INLINE drop #-}
   drop :: Int -> T a -> T a
drop Int
n T a
x = T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg98.-| String -> Int -> T a
forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
"drop" Int
n
   {-# INLINE dropMarginRem #-}
   dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem Int
n Int
m T a
x =
      let (T a
z,~(Bool
b,T a
d)) =
             T a -> T a -> (T a, (Bool, T a))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg98.split
                (String -> Int -> T a
forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
"dropMargin/n" Int
m)
                (T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg98.-| String -> Int -> T a
forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
"dropMargin/m" Int
n)
      in  (if Bool
b then Int
0 else a -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (T a -> a
forall a. C a => T a -> a
Chunky98.toNumber T a
d),
           T a
x T a -> T a -> T a
forall a. C a => a -> a -> a
NonNeg98.-| T a
z)
   {-# INLINE splitAt #-}
   splitAt :: Int -> T a -> (T a, T a)
splitAt Int
n T a
x =
      ((Bool, T a) -> T a) -> (T a, (Bool, T a)) -> (T a, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd
         (\ ~(Bool
b,T a
d) -> if Bool
b then T a
d else T a
forall a. T a
Chunky98.zero)
         (T a -> T a -> (T a, (Bool, T a))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg98.split (String -> Int -> T a
forall a. (Num a, C a) => String -> Int -> T a
intToChunky98 String
"splitAt" Int
n) T a
x)
   {-# INLINE reverse #-}
   reverse :: T a -> T a
reverse = [a] -> T a
forall a. C a => [a] -> T a
Chunky98.fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall y. [y] -> [y]
List.reverse ([a] -> [a]) -> (T a -> [a]) -> T a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks


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

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

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

{-# INLINE concat #-}
concat :: (Monoid sig) => [sig] -> sig
concat :: forall sig. Monoid sig => [sig] -> sig
concat = [sig] -> sig
forall sig. Monoid sig => [sig] -> sig
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 :: forall sig. Transform sig => Int -> sig -> Bool
lengthAtLeast Int
n sig
xs =
   Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not (sig -> Bool
forall sig. Read sig => sig -> Bool
null (Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
n) sig
xs))

{-# INLINE lengthAtMost #-}
lengthAtMost :: (Transform sig) =>
   Int -> sig -> Bool
lengthAtMost :: forall sig. Transform sig => Int -> sig -> Bool
lengthAtMost Int
n sig
xs =
   Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& sig -> Bool
forall sig. Read sig => sig -> Bool
null (Int -> sig -> sig
forall sig. Transform sig => Int -> sig -> sig
drop Int
n sig
xs)

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