-- |
-- Module      : Streamly.Internal.Data.RingArray
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Unboxed, mutable ring arrays of fixed size. In case you need to expand the
-- size of a ring, copy it to a MutArray, expand the array and cast it back to
-- ring.

-- XXX Write benchmarks

module Streamly.Internal.Data.RingArray
    ( RingArray (..)
    , Ring

    -- * Debugging
    , showRing

    -- * Construction
    , createOfLast
    , castMutArray
    , castMutArrayWith
    , unsafeCastMutArray
    , unsafeCastMutArrayWith

    -- * Moving the Head
    , moveForward
    , moveReverse
    , moveBy

    -- * In-place Mutation
    , insert
    , replace
    , replace_
    , putIndex
    , modifyIndex

    -- * Random Access
    , getIndex
    , unsafeGetIndex
    , unsafeGetHead

    -- * Conversion
    , toList
    , toMutArray

    -- * Streams
    , read
    , readRev

    -- * Unfolds
    , reader
    , readerRev

    -- * Size
    , length
    , byteLength

    -- * Casting
    , cast
    , unsafeCast
    , asBytes
    , asMutArray
    , asMutArray_

    -- * Folds
    , foldlM'
    , fold

    -- * Stream of Rings
    , ringsOf
    , scanRingsOf
    , scanCustomFoldRingsBy
    , scanFoldRingsBy

    -- * Fast Byte Comparisons
    , eqArray
    , eqArrayN

    -- * Deprecated
    , unsafeFoldRing
    , unsafeFoldRingM
    , unsafeFoldRingNM
    , unsafeFoldRingFullM
    , slidingWindow
    , slidingWindowWith
    ) where

#include "ArrayMacros.h"
#include "inline.hs"

import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Proxy (Proxy(..))
import Data.Word (Word8)
import Fusion.Plugin.Types (Fuse(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Array.Type (Array)
import Streamly.Internal.Data.MutArray.Type (MutArray(..))
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)
import Streamly.Internal.Data.Scanl.Type (Scanl(..))
import Streamly.Internal.Data.Stream.Step (Step(..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..))
import Streamly.Internal.Data.Unbox (Unbox(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

import qualified Streamly.Internal.Data.Array.Type as Array
import qualified Streamly.Internal.Data.Fold.Type as Fold
import qualified Streamly.Internal.Data.MutArray.Type as MutArray
import qualified Streamly.Internal.Data.MutByteArray.Type as MutByteArray
import qualified Streamly.Internal.Data.Scanl.Type as Scanl
import qualified Streamly.Internal.Data.Stream.Transform as Stream
import qualified Streamly.Internal.Data.Stream.Type as Stream
-- import qualified Streamly.Internal.Data.Unfold as Unfold
-- XXX check split benchmarks

import Prelude hiding (length, concat, read)

-- $setup
-- >>> :m
-- >>> import qualified Streamly.Internal.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.MutArray as MutArray
-- >>> import qualified Streamly.Internal.Data.RingArray as RingArray
-- >>> import qualified Streamly.Internal.Data.Stream as Stream

-- XXX Need a feature in GHC to disable positional constructors for record
-- types, so that we can safely reorder the fields.
--
-- Empty (zero-sized) rings are not allowed in construction routines though the
-- code supports it. We can allow it if there is a compelling use case.
--
-- We could represent a ring as a tuple of array and ring head (MutArray a,
-- Int). The array never changes, only the head does so the array can be passed
-- as a constant in a loop.
--
-- Performance notes: Replacing the oldest item with the newest is a very
-- common operation, during this operation the only thing that changes is the
-- ring head. Updating the RingArray constructor because of that could be expensive,
-- therefore, either the RingArray constructor should be eliminated via fusion or we
-- should unbox it manually where needed to allow for only the head to change.

-- | A ring buffer is a circular buffer. A new element is inserted at a
-- position called the ring head which points to the oldest element in the
-- ring, an insert overwrites the oldest element. After inserting, the head is
-- moved to point to the next element which is now the oldest element.
--
-- Elements in the ring are indexed relative to the head. RingArray head is
-- designated as the index 0 of the ring buffer, it points to the oldest or the
-- first element in the buffer. Higher positive indices point to the newer
-- elements in the buffer. Index @-1@ points to the newest or the last element
-- in the buffer. Higher negative indices point to older elements.
--
-- The ring is of fixed size and cannot be expanded or reduced after creation.
-- Creation of zero sized rings is not allowed.
--
-- This module provides an unboxed implementation of ring buffers for best
-- performance.
--
data RingArray a = RingArray
    { forall a. RingArray a -> MutByteArray
ringContents :: {-# UNPACK #-} !MutByteArray
    , forall a. RingArray a -> Int
ringSize :: {-# UNPACK #-} !Int -- size of array in bytes
    , forall a. RingArray a -> Int
ringHead :: {-# UNPACK #-} !Int -- byte index in the array
    }

{-# DEPRECATED Ring "Please use RingArray instead." #-}
type Ring = RingArray

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- | Given byte offset relative to the ring head, compute the linear byte
-- offset in the array. Offset can be positive or negative. Invariants:
--
-- * RingArray size cannot be zero, this won't work correctly if so.
-- * Absolute value of offset must be less than or equal to the ring size.
-- * Offset must be integer multiple of element size.
{-# INLINE unsafeChangeHeadByOffset #-}
unsafeChangeHeadByOffset :: Int -> Int -> Int -> Int
unsafeChangeHeadByOffset :: Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
rh Int
rs Int
i =
    let i1 :: Int
i1 = Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
     in if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rs
        then Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rs
        else if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
             then Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs
             else Int
i1

-- | Convert a byte offset relative to the ring head to a byte offset in the
-- underlying mutable array. Offset can be positive or negative.
--
-- Throws an error if the offset is greater than or equal to the ring size.
{-# INLINE changeHeadByOffset #-}
changeHeadByOffset :: Int -> Int -> Int -> Int
changeHeadByOffset :: Int -> Int -> Int -> Int
changeHeadByOffset Int
rh Int
rs Int
i =
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
rs
    then Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
rh Int
rs Int
i
    else [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"changeHeadByOffset: absolute value of offset must be less "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"than the ring size"

-- | Move the ring head forward or backward by n slots. Moves forward if the
-- argument is positive and backward if it is negative.
--
-- Throws an error if the absolute value of count is more than or euqal to the
-- ring size.
{-# INLINE moveBy #-}
moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a
moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a
moveBy Int
n RingArray a
rb =
    let i :: Int
i = Int -> Int -> Int -> Int
changeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
     in RingArray a
rb {ringHead :: Int
ringHead = Int
i}

-- | the offset must be exactly the element size in bytes.
{-# INLINE incrHeadByOffset #-}
incrHeadByOffset :: Int -> Int -> Int -> Int
incrHeadByOffset :: Int -> Int -> Int -> Int
incrHeadByOffset Int
rh Int
rs Int
n =
    -- Note: This works even if the ring size is 0.
    let rh1 :: Int
rh1 = Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
     -- greater than is needed when rs = 0
     in if Int
rh1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rs
        then Int
0
        else Int
rh1

-- | Advance the ring head forward by 1 slot, the ring head will now point to
-- the next (newer) item, and the old ring head position will become the latest
-- or the newest item position.
--
-- >>> moveForward = RingArray.moveBy 1
--
{-# INLINE moveForward #-}
moveForward :: forall a. Unbox a => RingArray a -> RingArray a
moveForward :: forall a. Unbox a => RingArray a -> RingArray a
moveForward rb :: RingArray a
rb@RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
    RingArray a
rb { ringHead :: Int
ringHead = Int -> Int -> Int -> Int
incrHeadByOffset Int
ringHead Int
ringSize (SIZE_OF(a)) }

-- | the offset must be exactly the element size in bytes.
{-# INLINE decrHeadByOffset #-}
decrHeadByOffset :: Int -> Int -> Int -> Int
decrHeadByOffset :: Int -> Int -> Int -> Int
decrHeadByOffset Int
rh Int
rs Int
n =
    -- Note: This works even if the ring size is 0.
    -- Though the head should never be accessed when ring size is 0, so it
    -- should not matter what it is.
    if Int
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    then (if Int
rh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
rs else Int
rh) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
    else Int
0

-- | Move the ring head backward by 1 slot, the ring head will now point to
-- the prev (older) item, when the ring head is at the oldest item it will move
-- to the newest item.
--
-- >>> moveForward = RingArray.moveBy (-1)
--
{-# INLINE moveReverse #-}
moveReverse :: forall a. Unbox a => RingArray a -> RingArray a
moveReverse :: forall a. Unbox a => RingArray a -> RingArray a
moveReverse rb :: RingArray a
rb@RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
    RingArray a
rb { ringHead :: Int
ringHead = Int -> Int -> Int -> Int
decrHeadByOffset Int
ringHead Int
ringSize (SIZE_OF(a)) }

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

-- | The array must not be a slice, and the index must be within the bounds of
-- the array otherwise unpredictable behavior will occur.
{-# INLINE unsafeCastMutArrayWith #-}
unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
i MutArray a
arr =
    RingArray
        { ringContents :: MutByteArray
ringContents = MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr
        , ringSize :: Int
ringSize = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr
        , ringHead :: Int
ringHead = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
        }

-- | Cast a MutArray to a ring sharing the same memory without copying. The
-- ring head is at index 0 of the array. The array must not be a slice.
--
-- >>> unsafeCastMutArray = RingArray.unsafeCastMutArrayWith 0
--
{-# INLINE unsafeCastMutArray #-}
unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a
unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a
unsafeCastMutArray = Int -> MutArray a -> RingArray a
forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
0

-- XXX To avoid the failure we can either copy the array or have a ringStart
-- field in the ring. For copying we can have another API though.

-- XXX castMutArray is called unsafeFreeze in the Array module. Make the naming
-- consistent? Also we can use castMutArrayWith to specify the index and use
-- the default index 0.

-- | @castMutArray arr index@ casts a mutable array to a ring array having
-- the ring head at @index@ position in the array.
--
-- This operation throws an error if the index is not within the array bounds.
-- It returns Nothing if the array cannot be cast into ring because the array
-- is a slice. In that case clone the array and cast it or stream the array and
-- use 'createOfLast' to create a ring.
--
{-# INLINE castMutArrayWith #-}
castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith Int
i MutArray a
arr
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= MutArray a -> Int
forall a. Unbox a => MutArray a -> Int
MutArray.length MutArray a
arr
        = [Char] -> Maybe (RingArray a)
forall a. HasCallStack => [Char] -> a
error [Char]
"castMutArray: index must not be negative or >= array size"
    | MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        = RingArray a -> Maybe (RingArray a)
forall a. a -> Maybe a
Just (RingArray a -> Maybe (RingArray a))
-> RingArray a -> Maybe (RingArray a)
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> RingArray a
forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
i MutArray a
arr
    | Bool
otherwise = Maybe (RingArray a)
forall a. Maybe a
Nothing

-- | Cast a MutArray to a ring sharing the same memory without copying. The
-- ring head is at index 0 of the array. Cast fails with Nothing if the array
-- is a slice.
--
-- >>> castMutArray = RingArray.castMutArrayWith 0
--
{-# INLINE castMutArray #-}
castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)
castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)
castMutArray = Int -> MutArray a -> Maybe (RingArray a)
forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith Int
0

-------------------------------------------------------------------------------
-- Conversion to/from array
-------------------------------------------------------------------------------

-- | Modify a given index of a ring array using a modifier function.
--
-- /Unimplemented/
modifyIndex :: -- forall m a b. (MonadIO m, Unbox a) =>
    Int -> RingArray a -> (a -> (a, b)) -> m b
modifyIndex :: forall a b (m :: * -> *).
Int -> RingArray a -> (a -> (a, b)) -> m b
modifyIndex = Int -> RingArray a -> (a -> (a, b)) -> m b
forall a. HasCallStack => a
undefined

-- | /O(1)/ Write the given element at the given index relative to the current
-- position of the ring head. Index starts at 0, could be positive or negative.
--
-- Throws an error if the index is more than or equal to the size of the ring.
--
-- Performs in-place mutation of the array.
--
{-# INLINE putIndex #-}
putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> a -> m ()
-- putIndex ix ring val = modifyIndex ix ring (const (val, ()))
putIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> a -> m ()
putIndex Int
i RingArray a
ring a
x =
    -- Note: ring must be of non-zero size.
    let j :: Int
j = Int -> Int -> Int -> Int
changeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
     in IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
j (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
ring) a
x

-- XXX Expand the ring by inserting the newest element before the head. If the
-- number of elements before the head are lesser than the ones after it then
-- shift them all by one place to the left, moving the first element at the end
-- of the ring. Otherwise, shift the elements after the head by one place to
-- the right. Note this requires adding a capacity field to the ring. Also,
-- like mutarray we can reallocate the ring to expand the capacity.

-- | Insert a new element without replacing an old one. Expands the size of the
-- ring. This is similar to the snoc operation for MutArray.
--
-- /Unimplemented/
{-# INLINE insert #-}
insert :: -- (MonadIO m, Unbox a) =>
    RingArray a -> a -> m (RingArray a)
insert :: forall a (m :: * -> *). RingArray a -> a -> m (RingArray a)
insert = RingArray a -> a -> m (RingArray a)
forall a. HasCallStack => a
undefined

-- | Like 'replace' but does not return the old value of overwritten element.
--
-- Same as:
--
-- >>> replace_ rb x = RingArray.putIndex 0 rb x >> pure (RingArray.moveForward rb)
--
{-# INLINE replace_ #-}
replace_ :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a)
replace_ :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ RingArray a
rb a
newVal = do
    -- Note poke will corrupt memory if the ring size is 0.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb) a
newVal
    RingArray a -> m (RingArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> m (RingArray a)) -> RingArray a -> m (RingArray a)
forall a b. (a -> b) -> a -> b
$ RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb

-- | Return the element at the specified index without checking the bounds.
--
-- Unsafe because it does not check the bounds of the ring array.
{-# INLINE unsafeGetRawIndex #-}
unsafeGetRawIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a
unsafeGetRawIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
i RingArray a
ring = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
ring)

-- | Replace the oldest item in the ring (the item at the ring head) with a new
-- item and move the ring head to the remaining oldest item.
--
-- Throws an error if the ring is empty.
--
{-# INLINE replace #-}
replace :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a, a)
replace :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
replace RingArray a
rb a
newVal = do
    -- Note: ring size cannot be zero.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"insert: cannot insert in 0 sized ring"
    a
old <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) RingArray a
rb
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb) a
newVal
    (RingArray a, a) -> m (RingArray a, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb, a
old)

-------------------------------------------------------------------------------
-- Random reads
-------------------------------------------------------------------------------

-- | Like 'getIndex' but does not check the bounds. Unpredictable behavior
-- occurs if the index is more than or equal to the ring size.
{-# INLINE unsafeGetIndex #-}
unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a
unsafeGetIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetIndex Int
i RingArray a
ring =
    let rs :: Int
rs = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring
        j :: Int
j = Int -> Int -> Int -> Int
unsafeChangeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) Int
rs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
     in Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
j RingArray a
ring

-- | /O(1)/ Lookup the element at the given index relative to the ring head.
-- Index starts from 0, could be positive or negative. Returns Nothing if the
-- index is more than or equal to the size of the ring.
--
{-# INLINE getIndex #-}
getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m (Maybe a)
getIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m (Maybe a)
getIndex Int
i RingArray a
ring =
    let rs :: Int
rs = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring
     in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
rs
        then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetIndex Int
i RingArray a
ring
        else Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | /O(1)/ Lookup the element at the head position.
--
-- Prefer this over @unsafeGetIndex 0@ as it does not have have to perform an
-- index rollover check.
--
{-# INLINE unsafeGetHead #-}
unsafeGetHead :: (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead :: forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
ring = Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) RingArray a
ring

-------------------------------------------------------------------------------
-- Size
-------------------------------------------------------------------------------

-- | /O(1)/ Get the byte length of the ring.
--
{-# INLINE byteLength #-}
byteLength :: RingArray a -> Int
byteLength :: forall a. RingArray a -> Int
byteLength = RingArray a -> Int
forall a. RingArray a -> Int
ringSize

-- | /O(1)/ Get the length of the ring. i.e. the number of elements in the
-- ring.
--
{-# INLINE length #-}
length :: forall a. Unbox a => RingArray a -> Int
length :: forall a. Unbox a => RingArray a -> Int
length RingArray a
rb = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` SIZE_OF(a)

-------------------------------------------------------------------------------
-- Unfolds
-------------------------------------------------------------------------------

-- | Read the entire ring, starting at the ring head i.e. from oldest to
-- newest.
--
{-# INLINE_NORMAL reader #-}
reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a
reader :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
reader = ((RingArray a, Int) -> m (Step (RingArray a, Int) a))
-> (RingArray a -> m (RingArray a, Int))
-> Unfold m (RingArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (RingArray a, Int) -> m (Step (RingArray a, Int) a)
forall {m :: * -> *} {a}.
(MonadIO m, Unbox a) =>
(RingArray a, Int) -> m (Step (RingArray a, Int) a)
step RingArray a -> m (RingArray a, Int)
forall {m :: * -> *} {a}.
Monad m =>
RingArray a -> m (RingArray a, Int)
inject

    where

    inject :: RingArray a -> m (RingArray a, Int)
inject RingArray a
rb = (RingArray a, Int) -> m (RingArray a, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RingArray a
rb, RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb)

    step :: (RingArray a, Int) -> m (Step (RingArray a, Int) a)
step (RingArray a
rb, Int
n) = do
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (RingArray a, Int) a
forall s a. Step s a
Stop
        else do
            a
x <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
rb
            Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a))
-> Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (RingArray a, Int) -> Step (RingArray a, Int) a
forall s a. a -> s -> Step s a
Yield a
x (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a))

-- | Read the entire ring in reverse order, starting at the item before the
-- ring head i.e. from newest to oldest
--
{-# INLINE_NORMAL readerRev #-}
readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a
readerRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
readerRev = ((RingArray a, Int) -> m (Step (RingArray a, Int) a))
-> (RingArray a -> m (RingArray a, Int))
-> Unfold m (RingArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (RingArray a, Int) -> m (Step (RingArray a, Int) a)
forall {m :: * -> *} {a}.
(MonadIO m, Unbox a) =>
(RingArray a, Int) -> m (Step (RingArray a, Int) a)
step RingArray a -> m (RingArray a, Int)
forall {m :: * -> *} {a}.
(Monad m, Unbox a) =>
RingArray a -> m (RingArray a, Int)
inject

    where

    inject :: RingArray a -> m (RingArray a, Int)
inject RingArray a
rb = (RingArray a, Int) -> m (RingArray a, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveReverse RingArray a
rb, RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb)

    step :: (RingArray a, Int) -> m (Step (RingArray a, Int) a)
step (RingArray a
rb, Int
n) = do
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (RingArray a, Int) a
forall s a. Step s a
Stop
        else do
            a
x <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
rb
            Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a))
-> Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (RingArray a, Int) -> Step (RingArray a, Int) a
forall s a. a -> s -> Step s a
Yield a
x (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveReverse RingArray a
rb, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a))

-- | Read the entire ring as a stream, starting at the ring head i.e. from
-- oldest to newest.
--
{-# INLINE_NORMAL read #-}
read :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a
read :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read = Unfold m (RingArray a) a -> RingArray a -> Stream m a
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold m (RingArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
reader

-- | Read the entire ring as a stream, starting from newest to oldest elements.
--
{-# INLINE_NORMAL readRev #-}
readRev :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a
readRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
readRev = Unfold m (RingArray a) a -> RingArray a -> Stream m a
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold m (RingArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
readerRev

-------------------------------------------------------------------------------
-- Stream of arrays
-------------------------------------------------------------------------------

-- | @scanRingsOf n@ groups the input stream into a stream of ring arrays of
-- size up to @n@. The first ring would be of size 1, then 2, and so on up to
-- size n, when size n is reached the ring starts sliding out the oldest
-- elements and keeps the newest n elements.
--
-- Note that the ring emitted is a mutable reference, therefore, should not be
-- retained without copying otherwise the contents will change in the next
-- iteration of the stream.
--
{-# INLINE scanRingsOf #-}
scanRingsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m a (RingArray a)
scanRingsOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n = (Tuple3Fused' MutByteArray Int Int
 -> a -> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a)))
-> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
-> (Tuple3Fused' MutByteArray Int Int -> m (RingArray a))
-> (Tuple3Fused' MutByteArray Int Int -> m (RingArray a))
-> Scanl m a (RingArray a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
forall {m :: * -> *} {a} {b}.
(MonadIO m, Unbox a) =>
Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
step m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
forall {b}. m (Step (Tuple3Fused' MutByteArray Int Int) b)
initial Tuple3Fused' MutByteArray Int Int -> m (RingArray a)
forall {f :: * -> *} {a}.
Applicative f =>
Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract Tuple3Fused' MutByteArray Int Int -> m (RingArray a)
forall {f :: * -> *} {a}.
Applicative f =>
Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract

    where

    rSize :: Int
rSize = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)

    initial :: m (Step (Tuple3Fused' MutByteArray Int Int) b)
initial =
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then [Char] -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"scanRingsOf: window size must be > 0"
        else do
            MutByteArray
mba <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new Int
rSize
            Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3Fused' MutByteArray Int Int) b
 -> m (Step (Tuple3Fused' MutByteArray Int Int) b))
-> Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall s b. s -> Step s b
Partial (Tuple3Fused' MutByteArray Int Int
 -> Step (Tuple3Fused' MutByteArray Int Int) b)
-> Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Tuple3Fused' MutByteArray Int Int
forall a b c. a -> b -> c -> Tuple3Fused' a b c
Tuple3Fused' MutByteArray
mba Int
0 Int
0

    step :: Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
step (Tuple3Fused' MutByteArray
mba Int
rh Int
offset) a
a = do
        RingArray MutByteArray
_ Int
_ Int
rh1 <- RingArray a -> a -> m (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba Int
rSize Int
rh) a
a
        let offset1 :: Int
offset1 = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
        Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3Fused' MutByteArray Int Int) b
 -> m (Step (Tuple3Fused' MutByteArray Int Int) b))
-> Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall s b. s -> Step s b
Partial (Tuple3Fused' MutByteArray Int Int
 -> Step (Tuple3Fused' MutByteArray Int Int) b)
-> Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Tuple3Fused' MutByteArray Int Int
forall a b c. a -> b -> c -> Tuple3Fused' a b c
Tuple3Fused' MutByteArray
mba Int
rh1 Int
offset1

    -- XXX exitify optimization causes a problem here when modular folds are
    -- used. Sometimes inlining "extract" is helpful.
    {-# INLINE extract #-}
    extract :: Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract (Tuple3Fused' MutByteArray
mba Int
rh Int
offset) =
        let rs :: Int
rs = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
offset Int
rSize
            rh1 :: Int
rh1 = if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rSize then Int
0 else Int
rh
         in RingArray a -> f (RingArray a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> f (RingArray a)) -> RingArray a -> f (RingArray a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba Int
rs Int
rh1

-- | @ringsOf n stream@ groups the input stream into a stream of ring arrays of
-- size up to n. See 'scanRingsOf' for more details.
--
{-# INLINE_NORMAL ringsOf #-}
ringsOf :: forall m a. (MonadIO m, Unbox a) =>
    Int -> Stream m a -> Stream m (RingArray a)
ringsOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (RingArray a)
ringsOf Int
n = Scanl m a (RingArray a) -> Stream m a -> Stream m (RingArray a)
forall (m :: * -> *) a b.
Monad m =>
Scanl m a b -> Stream m a -> Stream m b
Stream.postscanl (Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n)

-- XXX to keep the order intact use RingArray.read. If order is not important for
-- the fold then we can use asMutArray which could be slightly faster.
-- f1 rb = Stream.fold f $ MutArray.read $ fst $ RingArray.asMutArray rb

-- XXX the size and the array pointer are constant in the stream, only the head
-- changes on each tick. So we can just emit the head in the loop and keep the
-- size and pointer global.

{-# INLINE_NORMAL scanCustomFoldRingsBy #-}
scanCustomFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>
    (RingArray a -> m b) -> Int -> Scanl m a b
-- Custom RingArray.fold performs better than the idiomatic implementations below,
-- perhaps because of some GHC optimization effect.
scanCustomFoldRingsBy :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(RingArray a -> m b) -> Int -> Scanl m a b
scanCustomFoldRingsBy RingArray a -> m b
f = (RingArray a -> m b) -> Scanl m a (RingArray a) -> Scanl m a b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Scanl m a b -> Scanl m a c
Scanl.rmapM RingArray a -> m b
f (Scanl m a (RingArray a) -> Scanl m a b)
-> (Int -> Scanl m a (RingArray a)) -> Int -> Scanl m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf

-- | Apply the given fold on sliding windows of the given size. Note that this
-- could be expensive because each operation goes through the entire window.
-- This should be used only if there is no efficient alternative way possible.
--
-- Examples:
--
-- >>> windowRange = RingArray.scanFoldRingsBy Fold.range
-- >>> windowMinimum = RingArray.scanFoldRingsBy Fold.minimum
-- >>> windowMaximum = RingArray.scanFoldRingsBy Fold.maximum
--
{-# INLINE scanFoldRingsBy #-}
scanFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>
    Fold m a b -> Int -> Scanl m a b
-- Custom RingArray.fold performs better than the idiomatic implementations below,
-- perhaps because of some GHC optimization effect.
scanFoldRingsBy :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> Int -> Scanl m a b
scanFoldRingsBy Fold m a b
f = (RingArray a -> m b) -> Int -> Scanl m a b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(RingArray a -> m b) -> Int -> Scanl m a b
scanCustomFoldRingsBy (Fold m a b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold Fold m a b
f)
-- scanFoldRingsBy f = Scanl.rmapM (fold f) . scanRingsOf
-- scanFoldRingsBy f = Scanl.rmapM (Unfold.fold f reader) . scanRingsOf
-- scanFoldRingsBy f = Scanl.rmapM (Stream.fold f . read) . scanRingsOf


-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- | @createOfLast n@ returns the last n elements of the stream in a ring
-- array. @n@ must be non-zero.
--
{-# INLINE createOfLast #-}
createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (RingArray a)
createOfLast :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
Int -> Fold m a (RingArray a)
createOfLast Int
n = Scanl m a (RingArray a) -> Fold m a (RingArray a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
Fold.fromScanl (Scanl m a (RingArray a) -> Fold m a (RingArray a))
-> Scanl m a (RingArray a) -> Fold m a (RingArray a)
forall a b. (a -> b) -> a -> b
$ Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n

-------------------------------------------------------------------------------
-- Casting
-------------------------------------------------------------------------------

-- | Cast a ring having elements of type @a@ into a ring having elements of
-- type @b@. The ring size must be a multiple of the size of type @b@.
--
{-# INLINE unsafeCast #-}
unsafeCast :: RingArray a -> RingArray b
unsafeCast :: forall a b. RingArray a -> RingArray b
unsafeCast RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
    RingArray
        { ringContents :: MutByteArray
ringContents = MutByteArray
ringContents
        , ringHead :: Int
ringHead = Int
ringHead
        , ringSize :: Int
ringSize = Int
ringSize
        }

-- | Cast a @RingArray a@ into a @RingArray Word8@.
--
asBytes :: RingArray a -> RingArray Word8
asBytes :: forall a. RingArray a -> RingArray Word8
asBytes = RingArray a -> RingArray Word8
forall a b. RingArray a -> RingArray b
unsafeCast

-- | Cast a ring having elements of type @a@ into a ring having elements of
-- type @b@. The length of the ring should be a multiple of the size of the
-- target element otherwise 'Nothing' is returned.
--
{-# INLINE cast #-}
cast :: forall a b. (Unbox b) => RingArray a -> Maybe (RingArray b)
cast :: forall a b. Unbox b => RingArray a -> Maybe (RingArray b)
cast RingArray a
ring =
    let len :: Int
len = RingArray a -> Int
forall a. RingArray a -> Int
byteLength RingArray a
ring
        r :: Int
r = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` SIZE_OF(b)
     in if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then Maybe (RingArray b)
forall a. Maybe a
Nothing
        else RingArray b -> Maybe (RingArray b)
forall a. a -> Maybe a
Just (RingArray b -> Maybe (RingArray b))
-> RingArray b -> Maybe (RingArray b)
forall a b. (a -> b) -> a -> b
$ RingArray a -> RingArray b
forall a b. RingArray a -> RingArray b
unsafeCast RingArray a
ring

-------------------------------------------------------------------------------
-- Equality
-------------------------------------------------------------------------------

-- | Like 'eqArray' but compares only N bytes instead of entire length of the
-- ring buffer. If N is bigger than the ring or array size, it is treated as an
-- error.
--
{-# INLINE eqArrayN #-}
eqArrayN :: RingArray a -> Array a -> Int -> IO Bool
eqArrayN :: forall a. RingArray a -> Array a -> Int -> IO Bool
eqArrayN RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} Array.Array{Int
MutByteArray
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
..} Int
nBytes
    | Int
nBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: n should be >= 0"
    | Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nBytes = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: array is shorter than n"
    | Int
ringSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nBytes = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: ring is shorter than n"
    | Int
nBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Int
nBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p1Len = do
          Int
part1 <-
              MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
                  MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
nBytes
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    | Bool
otherwise = do
          Int
part1 <-
              MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
                  MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
p1Len
          Int
part2 <-
              MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp MutByteArray
arrContents Int
p1Len MutByteArray
ringContents Int
0 Int
p2Len
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
part2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    where
    p1Len :: Int
p1Len = Int
ringSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ringHead
    p2Len :: Int
p2Len = Int
nBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p1Len

-- | Byte compare the entire length of ringBuffer with the given array,
-- starting at the supplied ring head index.  Returns true if the Array and
-- the ring have identical contents. If the array is bigger checks only
-- up to the ring length. If array is shorter than then ring, it is treated as
-- an error.
--
{-# INLINE eqArray #-}
eqArray :: RingArray a -> Array a -> IO Bool
eqArray :: forall a. RingArray a -> Array a -> IO Bool
eqArray RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} Array.Array{Int
MutByteArray
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
..}
    | Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ringSize = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: array is shorter than ring"
    | Bool
otherwise = do
          Int
part1 <-
              MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
                  MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
p1Len
          Int
part2 <-
              MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
                  MutByteArray
arrContents Int
p1Len MutByteArray
ringContents Int
0 Int
p2Len
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
part2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    where
    p1Len :: Int
p1Len = Int
ringSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ringHead
    p2Len :: Int
p2Len = Int
ringHead

-------------------------------------------------------------------------------
-- Folding
-------------------------------------------------------------------------------

-- Note: INLINE_NORMAL is important for use in scanFoldRingsBy

-- | Fold the entire length of a ring buffer starting at the current ring head.
--
{-# INLINE_NORMAL fold #-}
fold :: forall m a b. (MonadIO m, Unbox a)
    => Fold m a b -> RingArray a -> m b
-- These are slower when used in a scan extract. One of the issues is the
-- exitify optimization, there could be others.
-- fold f rb = Unfold.fold f reader rb
-- fold f rb = Stream.fold f $ read rb
fold :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
_ s -> m b
final) RingArray a
rb = do
    Step s b
res <- m (Step s b)
initial
    case Step s b
res of
        Fold.Partial s
fs -> SPEC -> Int -> s -> m b
go SPEC
SPEC Int
rh s
fs
        Fold.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

    where

    rh :: Int
rh = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb

    -- Note: Passing the SPEC arg seems to give better results in windowRange
    -- benchmarks for larger windows, while worse results for smaller windows.
    {-# INLINE go #-}
    go :: SPEC -> Int -> s -> m b
go !SPEC
_ Int
index !s
fs = do
        a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
        Step s b
r <- s -> a -> m (Step s b)
step s
fs a
x
        case Step s b
r of
            Fold.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            Fold.Partial s
s -> do
                let next :: Int
next = Int -> Int -> Int -> Int
incrHeadByOffset Int
index (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (SIZE_OF(a))
                if Int
next Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rh
                then s -> m b
final s
s
                else SPEC -> Int -> s -> m b
go SPEC
SPEC Int
next s
s

-- XXX This was for folding when the ring is not full, now we do not support
-- that so this should not be needed.

-- | Fold the buffer starting from ringStart up to the given index using a pure
-- step function. This is useful to fold the items in the ring when the ring is
-- not full. The supplied index is usually the end of the ring.
--
-- Unsafe because the supplied index is not checked to be in range.
{-# DEPRECATED unsafeFoldRing "This function will be removed in future." #-}
{-# INLINE unsafeFoldRing #-}
unsafeFoldRing :: forall a b. Unbox a
    => Int -> (b -> a -> b) -> b -> RingArray a -> IO b
unsafeFoldRing :: forall a b.
Unbox a =>
Int -> (b -> a -> b) -> b -> RingArray a -> IO b
unsafeFoldRing !Int
len b -> a -> b
f b
z RingArray a
rb = b -> Int -> IO b
forall {m :: * -> *}. MonadIO m => b -> Int -> m b
go b
z Int
0

    where

    go :: b -> Int -> m b
go !b
acc !Int
index
        | Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
        | Bool
otherwise = do
            a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
            b -> Int -> m b
go (b -> a -> b
f b
acc a
x) (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))

-- | Like unsafeFoldRing but with a monadic step function.
{-# DEPRECATED unsafeFoldRingM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingM #-}
unsafeFoldRingM :: forall m a b. (MonadIO m, Unbox a)
    => Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingM !Int
len b -> a -> m b
f b
z RingArray a
rb = b -> Int -> m b
go b
z Int
0

    where

    go :: b -> Int -> m b
go !b
acc !Int
index
        | Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
        | Bool
otherwise = do
            a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
            b
acc1 <- b -> a -> m b
f b
acc a
x
            b -> Int -> m b
go b
acc1 (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))

-- | Fold the entire length of a ring buffer starting at the current ring head.
--
-- Note, this will crash on ring of 0 size.
--
{-# INLINE foldlM' #-}
foldlM' :: forall m a b. (MonadIO m, Unbox a)
    => (b -> a -> m b) -> b -> RingArray a -> m b
foldlM' :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
foldlM' b -> a -> m b
f b
z = Fold m a b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold ((b -> a -> m b) -> m b -> Fold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
Fold.foldlM' b -> a -> m b
f (b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
z))

-- These are slower when used in a scan extract. One of the issues is the
-- exitify optimization, there could be others.
-- foldlM' f z rb = Unfold.fold (Fold.foldlM' f (pure z)) reader rb
-- foldlM' f z rb = Stream.fold (Fold.foldlM' f (pure z)) $ read rb

{-
foldlM' f z rb = go z rh

    where

    rh = ringHead rb

    go !acc !index = do
        x <- unsafeGetRawIndex index rb
        acc' <- f acc x
        let next = incrHeadByOffset index (ringSize rb) (SIZE_OF(a))
        if next == rh
        then return acc'
        else go acc' next
-}

{-# DEPRECATED unsafeFoldRingFullM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingFullM #-}
unsafeFoldRingFullM :: forall m a b. (MonadIO m, Unbox a)
    => (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingFullM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingFullM = (b -> a -> m b) -> b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
foldlM'

-- | Fold @n@ items in the ring starting at the ring head. Won't fold more
-- than the length of the ring even if @n@ is larger.
--
-- Note, this will crash on ring of 0 size.
--
{-# DEPRECATED unsafeFoldRingNM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingNM #-}
unsafeFoldRingNM :: forall m a b. (MonadIO m, Unbox a)
    => Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingNM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingNM Int
count b -> a -> m b
f b
z RingArray a
rb = Int -> b -> Int -> m b
forall {t}. (Eq t, Num t) => t -> b -> Int -> m b
go Int
count b
z Int
rh

    where

    rh :: Int
rh = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb

    go :: t -> b -> Int -> m b
go t
0 b
acc Int
_ = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
    go !t
n !b
acc !Int
index = do
        a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
        b
acc' <- b -> a -> m b
f b
acc a
x
        let next :: Int
next = Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
index (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (SIZE_OF(a))
        if Int
next Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rh Bool -> Bool -> Bool
|| t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
            then b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'
            else t -> b -> Int -> m b
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) b
acc' Int
next

-- | Cast the ring to a mutable array. Return the mutable array as well as the
-- current position of the ring head. Note that the array does not start with
-- the current ring head. The array refers to the same memory as the ring.
{-# INLINE asMutArray #-}
asMutArray :: RingArray a -> (MutArray a, Int)
asMutArray :: forall a. RingArray a -> (MutArray a, Int)
asMutArray RingArray a
rb =
    ( MutArray
        { arrContents :: MutByteArray
arrContents = RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb
        , arrStart :: Int
arrStart = Int
0
        , arrEnd :: Int
arrEnd = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
        , arrBound :: Int
arrBound = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
        }
    , RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb
    )

{-# INLINE asMutArray_ #-}
asMutArray_ :: RingArray a -> MutArray a
asMutArray_ :: forall a. RingArray a -> MutArray a
asMutArray_ RingArray a
rb =
    MutArray
        { arrContents :: MutByteArray
arrContents = RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb
        , arrStart :: Int
arrStart = Int
0
        , arrEnd :: Int
arrEnd = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
        , arrBound :: Int
arrBound = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
        }

-- XXX We can use bulk copy using memcpy or at least a Word64 at a time.

-- | Copy the ring to a MutArray, the first element of the MutArray is the
-- oldest element of the ring (i.e. ring head) and the last is the newest.
--
-- >>> toMutArray rb = Stream.fold (MutArray.createOf (RingArray.length rb)) $ RingArray.read rb
--
{-# INLINE toMutArray #-}
toMutArray :: (MonadIO m, Unbox a) => RingArray a -> m (MutArray a)
toMutArray :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m (MutArray a)
toMutArray RingArray a
rb = Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
MutArray.fromStreamN (RingArray a -> Int
forall a. Unbox a => RingArray a -> Int
length RingArray a
rb) (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ RingArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read RingArray a
rb
{-
toMutArray rb = do
    -- Using unpinned array here instead of pinned
    arr <- liftIO $ MutArray.emptyOf (length rb)
    let snoc' b a = liftIO $ MutArray.unsafeSnoc b a
    foldlM' snoc' arr rb
-}

-- | Copy the ring to a list, the first element of the list is the oldest
-- element of the ring (i.e. ring head) and the last is the newest.
--
-- >>> toList = Stream.toList . RingArray.read
--
{-# INLINE toList #-}
toList :: (MonadIO m, Unbox a) => RingArray a -> m [a]
toList :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m [a]
toList = Stream m a -> m [a]
forall (m :: * -> *) a. Monad m => Stream m a -> m [a]
Stream.toList (Stream m a -> m [a])
-> (RingArray a -> Stream m a) -> RingArray a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RingArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read

-- | Show the contents of a RingArray as a list.
--
-- >>> showRing rb = RingArray.toList rb >>= return . show
--
showRing :: (Unbox a, Show a) => RingArray a -> IO String
showRing :: forall a. (Unbox a, Show a) => RingArray a -> IO [Char]
showRing RingArray a
rb = [a] -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> [Char]) -> IO [a] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RingArray a -> IO [a]
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m [a]
toList RingArray a
rb

{-# ANN type SlidingWindow Fuse #-}
data SlidingWindow a s = SWArray !a !Int !s !Int | SWRing !a !Int !s

-- | Like slidingWindow but also provides the entire ring contents as an Array.
-- The array reflects the state of the ring after inserting the incoming
-- element.
--
-- IMPORTANT NOTE: The ring is mutable, therefore, the result of @(m (Array
-- a))@ action depends on when it is executed. It does not capture the sanpshot
-- of the ring at a particular time.
{-# DEPRECATED slidingWindowWith "Please use Scanl.incrScanWith instead." #-}
{-# INLINE slidingWindowWith #-}
slidingWindowWith :: forall m a b. (MonadIO m, Unbox a)
    => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith Int
n (Fold s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
    (SlidingWindow MutByteArray s
 -> a -> m (Step (SlidingWindow MutByteArray s) b))
-> m (Step (SlidingWindow MutByteArray s) b)
-> (SlidingWindow MutByteArray s -> m b)
-> (SlidingWindow MutByteArray s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold SlidingWindow MutByteArray s
-> a -> m (Step (SlidingWindow MutByteArray s) b)
step m (Step (SlidingWindow MutByteArray s) b)
initial SlidingWindow MutByteArray s -> m b
forall {a}. SlidingWindow a s -> m b
extract SlidingWindow MutByteArray s -> m b
forall {a}. SlidingWindow a s -> m b
final

    where

    initial :: m (Step (SlidingWindow MutByteArray s) b)
initial = do
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then [Char] -> m (Step (SlidingWindow MutByteArray s) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Window size must be > 0"
        else do
            Step s b
r <- m (Step s b)
initial1
            MutArray a
arr :: MutArray.MutArray a <- IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
MutArray.emptyOf Int
n
            Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
 -> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
                case Step s b
r of
                    Partial s
s -> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial
                        (SlidingWindow MutByteArray s
 -> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> Int -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> Int -> SlidingWindow a s
SWArray (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
MutArray.arrContents MutArray a
arr) Int
0 s
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b

    step :: SlidingWindow MutByteArray s
-> a -> m (Step (SlidingWindow MutByteArray s) b)
step (SWArray MutByteArray
mba Int
rh s
st Int
i) a
a = do
        RingArray MutByteArray
_ Int
_ Int
rh1 <- RingArray a -> a -> m (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) rh) a
        let size :: Int
size = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
        Step s b
r <- s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 s
st ((a
a, Maybe a
forall a. Maybe a
Nothing), MutArray a -> m (MutArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
mba Int
0 Int
size Int
size))
        Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
 -> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
r of
                Partial s
s ->
                    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                    then SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
 -> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> Int -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> Int -> SlidingWindow a s
SWArray MutByteArray
mba Int
rh1 s
s (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    else SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
 -> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> SlidingWindow a s
SWRing MutByteArray
mba Int
rh1 s
s
                Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b

    step (SWRing MutByteArray
mba Int
rh s
st) a
a = do
        (rb1 :: RingArray a
rb1@(RingArray MutByteArray
_ Int
_ Int
rh1), a
old) <-
            RingArray a -> a -> m (RingArray a, a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
replace (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) rh) a
        Step s b
r <- s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 s
st ((a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
old), RingArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m (MutArray a)
toMutArray RingArray a
rb1)
        Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
 -> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
r of
                Partial s
s -> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
 -> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> SlidingWindow a s
SWRing MutByteArray
mba Int
rh1 s
s
                Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b

    extract :: SlidingWindow a s -> m b
extract (SWArray a
_ Int
_ s
st Int
_) = s -> m b
extract1 s
st
    extract (SWRing a
_ Int
_ s
st) = s -> m b
extract1 s
st

    final :: SlidingWindow a s -> m b
final (SWArray a
_ Int
_ s
st Int
_) = s -> m b
final1 s
st
    final (SWRing a
_ Int
_ s
st) = s -> m b
final1 s
st

-- | @slidingWindow collector@ is an incremental sliding window
-- fold that does not require all the intermediate elements in a computation.
-- This maintains @n@ elements in the window, when a new element comes it slides
-- out the oldest element and the new element along with the old element are
-- supplied to the collector fold.
--
-- The 'Maybe' type is for the case when initially the window is filling and
-- there is no old element.
--
{-# DEPRECATED slidingWindow "Please use Scanl.incrScan instead." #-}
{-# INLINE slidingWindow #-}
slidingWindow :: forall m a b. (MonadIO m, Unbox a)
    => Int -> Fold m (a, Maybe a) b -> Fold m a b
slidingWindow :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m (a, Maybe a) b -> Fold m a b
slidingWindow Int
n Fold m (a, Maybe a) b
f = Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith Int
n ((((a, Maybe a), m (MutArray a)) -> (a, Maybe a))
-> Fold m (a, Maybe a) b -> Fold m ((a, Maybe a), m (MutArray a)) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap ((a, Maybe a), m (MutArray a)) -> (a, Maybe a)
forall a b. (a, b) -> a
fst Fold m (a, Maybe a) b
f)