-- |
-- Module      : Streamly.Internal.Data.Ring.Unboxed
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- A ring array is a circular mutable array.

-- XXX Write benchmarks
-- XXX Make the implementation similar to mutable array
-- XXX Rename this module to Data.RingArray.Storable

module Streamly.Internal.Data.Ring.Unboxed
    ( Ring(..)

    -- * Construction
    , new
    , newRing
    , writeN

    , advance
    , moveBy
    , startOf

    -- * Random writes
    , unsafeInsert
    , slide
    , putIndex
    , modifyIndex

    -- * Unfolds
    , read
    , readRev

    -- * Random reads
    , getIndex
    , getIndexUnsafe
    , getIndexRev

    -- * Size
    , length
    , byteLength
    -- , capacity
    , byteCapacity
    , bytesFree

    -- * Casting
    , cast
    , castUnsafe
    , asBytes
    , fromArray

    -- * Folds
    , unsafeFoldRing
    , unsafeFoldRingM
    , unsafeFoldRingFullM
    , unsafeFoldRingNM

    -- * Stream of Arrays
    , ringsOf

    -- * Fast Byte Comparisons
    , unsafeEqArray
    , unsafeEqArrayN

    , slidingWindow
    , slidingWindowWith
    ) where

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

import Control.Exception (assert)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Word (Word8)
import Foreign.Storable
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.Ptr (plusPtr, minusPtr, castPtr)
import Streamly.Internal.Data.Unboxed as Unboxed (Unbox, peekWith)
import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)
import GHC.Ptr (Ptr(..))
import Streamly.Internal.Data.Array.Mut.Type (MutArray)
import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)
import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)

import qualified Streamly.Internal.Data.Array.Mut.Type as MA
import qualified Streamly.Internal.Data.Array.Type as A

import Prelude hiding (length, concat, read)

-- $setup
-- >>> :m
-- >>> import qualified Streamly.Internal.Data.Ring.Unboxed as Ring

-- | A ring buffer is a mutable array of fixed size. Initially the array is
-- empty, with ringStart pointing at the start of allocated memory. We call the
-- next location to be written in the ring as ringHead. Initially ringHead ==
-- ringStart. When the first item is added, ringHead points to ringStart +
-- sizeof item. When the buffer becomes full ringHead would wrap around to
-- ringStart. When the buffer is full, ringHead always points at the oldest
-- item in the ring and the newest item added always overwrites the oldest
-- item.
--
-- When using it we should keep in mind that a ringBuffer is a mutable data
-- structure. We should not leak out references to it for immutable use.
--
data Ring a = Ring
    { Ring a -> ForeignPtr a
ringStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address
    , Ring a -> Ptr a
ringBound :: {-# UNPACK #-} !(Ptr a)        -- first address beyond allocated memory
    }

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

-- | Get the first address of the ring as a pointer.
startOf :: Ring a -> Ptr a
startOf :: Ring a -> Ptr a
startOf = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (ForeignPtr a -> Ptr a)
-> (Ring a -> ForeignPtr a) -> Ring a -> Ptr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ring a -> ForeignPtr a
forall a. Ring a -> ForeignPtr a
ringStart

-- | Create a new ringbuffer and return the ring buffer and the ringHead.
-- Returns the ring and the ringHead, the ringHead is same as ringStart.
{-# INLINE new #-}
new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)
new :: Int -> IO (Ring a, Ptr a)
new Int
count = do
    let size :: Int
size = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
    ForeignPtr a
fptr <- Int -> Int -> IO (ForeignPtr a)
forall a. Int -> Int -> IO (ForeignPtr a)
mallocPlainForeignPtrAlignedBytes Int
size (a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a))
    let p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
fptr
    (Ring a, Ptr a) -> IO (Ring a, Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ring :: forall a. ForeignPtr a -> Ptr a -> Ring a
Ring
        { ringStart :: ForeignPtr a
ringStart = ForeignPtr a
fptr
        , ringBound :: Ptr a
ringBound = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size
        }, Ptr a
p)

-- XXX Rename this to "new".
--
-- | @newRing count@ allocates an empty array that can hold 'count' items.  The
-- memory of the array is uninitialized and the allocation is aligned as per
-- the 'Storable' instance of the type.
--
-- /Unimplemented/
{-# INLINE newRing #-}
newRing :: Int -> m (Ring a)
newRing :: Int -> m (Ring a)
newRing = Int -> m (Ring a)
forall a. HasCallStack => a
undefined

-- | Advance the ringHead by 1 item, wrap around if we hit the end of the
-- array.
{-# INLINE advance #-}
advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a
advance :: Ring a -> Ptr a -> Ptr a
advance Ring{Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} Ptr a
ringHead =
    let ptr :: Ptr b
ptr = Ptr a
PTR_NEXT(ringHead,a)
    in if Ptr a
forall b. Ptr b
ptr Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<  Ptr a
ringBound
       then Ptr a
forall b. Ptr b
ptr
       else ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
ringStart

-- | Move the ringHead by n items. The direction depends on the sign on whether
-- n is positive or negative. Wrap around if we hit the beginning or end of the
-- array.
{-# INLINE moveBy #-}
moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a
moveBy :: Int -> Ring a -> Ptr a -> Ptr a
moveBy Int
by Ring {Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} Ptr a
ringHead = Ptr a
ringStartPtr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
advanceFromHead

    where

    elemSize :: Int
elemSize = STORABLE_SIZE_OF(a)
    ringStartPtr :: Ptr a
ringStartPtr = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
ringStart
    lenInBytes :: Int
lenInBytes = Ptr a
ringBound Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
ringStartPtr
    offInBytes :: Int
offInBytes = Ptr a
ringHead Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
ringStartPtr
    len :: Int
len = Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Int
lenInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lenInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize
    off :: Int
off = Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Int
offInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
offInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize
    advanceFromHead :: Int
advanceFromHead = (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
by Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize

-- XXX Move the writeLastN from array module here.
--
-- | @writeN n@ is a rolling fold that keeps the last n elements of the stream
-- in a ring array.
--
-- /Unimplemented/
{-# INLINE writeN #-}
writeN :: -- (Storable a, MonadIO m) =>
    Int -> Fold m a (Ring a)
writeN :: Int -> Fold m a (Ring a)
writeN = Int -> Fold m a (Ring a)
forall a. HasCallStack => a
undefined

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

-- | Cast a mutable array to a ring array.
fromArray :: MutArray a -> Ring a
fromArray :: MutArray a -> Ring a
fromArray = MutArray a -> Ring a
forall a. HasCallStack => a
undefined

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

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

-- | /O(1)/ Write the given element at the given index in the ring array.
-- Performs in-place mutation of the array.
--
-- >>> putIndex arr ix val = Ring.modifyIndex arr ix (const (val, ()))
--
-- /Unimplemented/
{-# INLINE putIndex #-}
putIndex :: -- (MonadIO m, Storable a) =>
    Ring a -> Int -> a -> m ()
putIndex :: Ring a -> Int -> a -> m ()
putIndex = Ring a -> Int -> a -> m ()
forall a. HasCallStack => a
undefined

-- | Insert an item at the head of the ring, when the ring is full this
-- replaces the oldest item in the ring with the new item. This is unsafe
-- beause ringHead supplied is not verified to be within the Ring. Also,
-- the ringStart foreignPtr must be guaranteed to be alive by the caller.
{-# INLINE unsafeInsert #-}
unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
unsafeInsert :: Ring a -> Ptr a -> a -> IO (Ptr a)
unsafeInsert Ring a
rb Ptr a
ringHead a
newVal = do
    Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ringHead a
newVal
    -- touchForeignPtr (ringStart rb)
    Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
advance Ring a
rb Ptr a
ringHead

-- | Insert an item at the head of the ring, when the ring is full this
-- replaces the oldest item in the ring with the new item.
--
-- /Unimplemented/
slide :: -- forall m a. (MonadIO m, Storable a) =>
    Ring a -> a -> m (Ring a)
slide :: Ring a -> a -> m (Ring a)
slide = Ring a -> a -> m (Ring a)
forall a. HasCallStack => a
undefined

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

-- | Return the element at the specified index without checking the bounds.
--
-- Unsafe because it does not check the bounds of the ring array.
{-# INLINE_NORMAL getIndexUnsafe #-}
getIndexUnsafe :: -- forall m a. (MonadIO m, Storable a) =>
    Ring a -> Int -> m a
getIndexUnsafe :: Ring a -> Int -> m a
getIndexUnsafe = Ring a -> Int -> m a
forall a. HasCallStack => a
undefined

-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
--
{-# INLINE getIndex #-}
getIndex :: -- (MonadIO m, Storable a) =>
    Ring a -> Int -> m a
getIndex :: Ring a -> Int -> m a
getIndex = Ring a -> Int -> m a
forall a. HasCallStack => a
undefined

-- | /O(1)/ Lookup the element at the given index from the end of the array.
-- Index starts from 0.
--
-- Slightly faster than computing the forward index and using getIndex.
--
{-# INLINE getIndexRev #-}
getIndexRev :: -- (MonadIO m, Storable a) =>
    Ring a -> Int -> m a
getIndexRev :: Ring a -> Int -> m a
getIndexRev = Ring a -> Int -> m a
forall a. HasCallStack => a
undefined

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

-- | /O(1)/ Get the byte length of the array.
--
-- /Unimplemented/
{-# INLINE byteLength #-}
byteLength :: Ring a -> Int
byteLength :: Ring a -> Int
byteLength = Ring a -> Int
forall a. HasCallStack => a
undefined

-- | /O(1)/ Get the length of the array i.e. the number of elements in the
-- array.
--
-- Note that 'byteLength' is less expensive than this operation, as 'length'
-- involves a costly division operation.
--
-- /Unimplemented/
{-# INLINE length #-}
length :: -- forall a. Storable a =>
    Ring a -> Int
length :: Ring a -> Int
length = Ring a -> Int
forall a. HasCallStack => a
undefined

-- | Get the total capacity of an array. An array may have space reserved
-- beyond the current used length of the array.
--
-- /Pre-release/
{-# INLINE byteCapacity #-}
byteCapacity :: Ring a -> Int
byteCapacity :: Ring a -> Int
byteCapacity = Ring a -> Int
forall a. HasCallStack => a
undefined

-- | The remaining capacity in the array for appending more elements without
-- reallocation.
--
-- /Pre-release/
{-# INLINE bytesFree #-}
bytesFree :: Ring a -> Int
bytesFree :: Ring a -> Int
bytesFree = Ring a -> Int
forall a. HasCallStack => a
undefined

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

-- XXX We can read the ring in a loop and use "take" to restrict the number of
-- elements to be taken.
--
-- | Read n elements from the ring starting at the supplied ring head. If n is
-- more than the ring size it keeps reading the ring in a circular fashion.
--
-- If the ring is not full the user must ensure than n is less than or equal to
-- the number of valid elements in the ring.
--
-- /Internal/
{-# INLINE_NORMAL read #-}
read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a
read :: Unfold m (Ring a, Ptr a, Int) a
read = ((Ring a, Ptr a, Int) -> m (Step (Ring a, Ptr a, Int) a))
-> ((Ring a, Ptr a, Int) -> m (Ring a, Ptr a, Int))
-> Unfold m (Ring a, Ptr a, Int) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (Ring a, Ptr a, Int) -> m (Step (Ring a, Ptr a, Int) a)
forall c (m :: * -> *) a.
(Ord c, Num c, MonadIO m, Storable a) =>
(Ring a, Ptr a, c) -> m (Step (Ring a, Ptr a, c) a)
step (Ring a, Ptr a, Int) -> m (Ring a, Ptr a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    step :: (Ring a, Ptr a, c) -> m (Step (Ring a, Ptr a, c) a)
step (Ring a
rb, Ptr a
rh, c
n) = do
        if c
n c -> c -> Bool
forall a. Ord a => a -> a -> Bool
<= c
0
        then do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (Ring a -> ForeignPtr a
forall a. Ring a -> ForeignPtr a
ringStart Ring a
rb)
            Step (Ring a, Ptr a, c) a -> m (Step (Ring a, Ptr a, c) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Ring a, Ptr a, c) a
forall s a. Step s a
Stop
        else do
            a
x <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
            let rh1 :: Ptr a
rh1 = Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
advance Ring a
rb Ptr a
rh
            Step (Ring a, Ptr a, c) a -> m (Step (Ring a, Ptr a, c) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Ring a, Ptr a, c) a -> m (Step (Ring a, Ptr a, c) a))
-> Step (Ring a, Ptr a, c) a -> m (Step (Ring a, Ptr a, c) a)
forall a b. (a -> b) -> a -> b
$ a -> (Ring a, Ptr a, c) -> Step (Ring a, Ptr a, c) a
forall s a. a -> s -> Step s a
Yield a
x (Ring a
rb, Ptr a
rh1, c
n c -> c -> c
forall a. Num a => a -> a -> a
- c
1)

-- | Unfold a ring array into a stream in reverse order.
--
-- /Unimplemented/
{-# INLINE_NORMAL readRev #-}
readRev :: -- forall m a. (MonadIO m, Storable a) =>
    Unfold m (MutArray a) a
readRev :: Unfold m (MutArray a) a
readRev = Unfold m (MutArray a) a
forall a. HasCallStack => a
undefined

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

-- XXX Move this module to a lower level Ring/Type module and move ringsOf to a
-- higher level ring module where we can import "scan".

-- | @ringsOf n stream@ groups the input stream into a stream of
-- ring arrays of size n. Each ring is a sliding window of size n.
--
-- /Unimplemented/
{-# INLINE_NORMAL ringsOf #-}
ringsOf :: -- forall m a. (MonadIO m, Storable a) =>
    Int -> Stream m a -> Stream m (MutArray a)
ringsOf :: Int -> Stream m a -> Stream m (MutArray a)
ringsOf = Int -> Stream m a -> Stream m (MutArray a)
forall a. HasCallStack => a
undefined -- Stream.scan (writeN n)

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

-- | Cast an array having elements of type @a@ into an array having elements of
-- type @b@. The array size must be a multiple of the size of type @b@.
--
-- /Unimplemented/
--
castUnsafe :: Ring a -> Ring b
castUnsafe :: Ring a -> Ring b
castUnsafe = Ring a -> Ring b
forall a. HasCallStack => a
undefined

-- | Cast an @Array a@ into an @Array Word8@.
--
-- /Unimplemented/
--
asBytes :: Ring a -> Ring Word8
asBytes :: Ring a -> Ring Word8
asBytes = Ring a -> Ring Word8
forall a b. Ring a -> Ring b
castUnsafe

-- | Cast an array having elements of type @a@ into an array having elements of
-- type @b@. The length of the array should be a multiple of the size of the
-- target element otherwise 'Nothing' is returned.
--
-- /Pre-release/
--
cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)
cast :: Ring a -> Maybe (Ring b)
cast Ring a
arr =
    let len :: Int
len = Ring a -> Int
forall a. Ring a -> Int
byteLength Ring a
arr
        r :: Int
r = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` STORABLE_SIZE_OF(b)
     in if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then Maybe (Ring b)
forall a. Maybe a
Nothing
        else Ring b -> Maybe (Ring b)
forall a. a -> Maybe a
Just (Ring b -> Maybe (Ring b)) -> Ring b -> Maybe (Ring b)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ring b
forall a b. Ring a -> Ring b
castUnsafe Ring a
arr

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

-- XXX remove all usage of unsafeInlineIO
--
-- | Like 'unsafeEqArray' but compares only N bytes instead of entire length of
-- the ring buffer. This is unsafe because the ringHead Ptr is not checked to
-- be in range.
{-# INLINE unsafeEqArrayN #-}
unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool
unsafeEqArrayN :: Ring a -> Ptr a -> Array a -> Int -> Bool
unsafeEqArrayN Ring{Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} Ptr a
rh A.Array{Int
MutableByteArray
arrEnd :: forall a. Array a -> Int
arrStart :: forall a. Array a -> Int
arrContents :: forall a. Array a -> MutableByteArray
arrEnd :: Int
arrStart :: Int
arrContents :: MutableByteArray
..} Int
nBytes
    | Int
nBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeEqArrayN: n should be >= 0"
    | Int
nBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
    | Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
unsafeInlineIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> IO Bool
check (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
rh) Int
0

    where

    w8Contents :: MutableByteArray
w8Contents = MutableByteArray
arrContents

    check :: Ptr Word8 -> Int -> IO Bool
check Ptr Word8
p Int
i = do
        (Word8
relem :: Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
        Word8
aelem <- MutableByteArray -> Int -> IO Word8
forall a. Unbox a => MutableByteArray -> Int -> IO a
peekWith MutableByteArray
w8Contents Int
i
        if Word8
relem Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
aelem
        then Ptr Word8 -> Int -> IO Bool
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    go :: Ptr Word8 -> Int -> IO Bool
go Ptr Word8
p Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nBytes = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        | Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
ringBound =
            Ptr Word8 -> Int -> IO Bool
go (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
ringStart)) Int
i
        | Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
rh = ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
ringStart IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        | Bool
otherwise = Ptr Word8 -> Int -> IO Bool
check Ptr Word8
p Int
i

-- XXX This is not modular. We should probably just convert the array and the
-- ring buffer to streams and compare the two streams. Need to check perf
-- though.

-- | Byte compare the entire length of ringBuffer with the given array,
-- starting at the supplied ringHead pointer.  Returns true if the Array and
-- the ringBuffer have identical contents.
--
-- This is unsafe because the ringHead Ptr is not checked to be in range. The
-- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS
-- ARE NOT CHECKED.
{-# INLINE unsafeEqArray #-}
unsafeEqArray :: Ring a -> Ptr a -> A.Array a -> Bool
unsafeEqArray :: Ring a -> Ptr a -> Array a -> Bool
unsafeEqArray Ring{Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} Ptr a
rh A.Array{Int
MutableByteArray
arrEnd :: Int
arrStart :: Int
arrContents :: MutableByteArray
arrEnd :: forall a. Array a -> Int
arrStart :: forall a. Array a -> Int
arrContents :: forall a. Array a -> MutableByteArray
..} =
    IO Bool -> Bool
forall a. IO a -> a
unsafeInlineIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> IO Bool
check (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
rh) Int
0

    where

    w8Contents :: MutableByteArray
w8Contents = MutableByteArray
arrContents

    check :: Ptr Word8 -> Int -> IO Bool
check Ptr Word8
p Int
i = do
        (Word8
relem :: Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
        Word8
aelem <- MutableByteArray -> Int -> IO Word8
forall a. Unbox a => MutableByteArray -> Int -> IO a
peekWith MutableByteArray
w8Contents Int
i
        if Word8
relem Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
aelem
        then Ptr Word8 -> Int -> IO Bool
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    go :: Ptr Word8 -> Int -> IO Bool
go Ptr Word8
p Int
i
        | Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
==
              Ptr a
ringBound = Ptr Word8 -> Int -> IO Bool
go (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
ringStart)) Int
i
        | Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
rh = ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
ringStart IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        | Bool
otherwise = Ptr Word8 -> Int -> IO Bool
check Ptr Word8
p Int
i

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

-- XXX We can unfold it into a stream and fold the stream instead.
-- XXX use MonadIO
--
-- | Fold the buffer starting from ringStart up to the given 'Ptr' using a pure
-- step function. This is useful to fold the items in the ring when the ring is
-- not full. The supplied pointer is usually the end of the ring.
--
-- Unsafe because the supplied Ptr is not checked to be in range.
{-# INLINE unsafeFoldRing #-}
unsafeFoldRing :: forall a b. Storable a
    => Ptr a -> (b -> a -> b) -> b -> Ring a -> b
unsafeFoldRing :: Ptr a -> (b -> a -> b) -> b -> Ring a -> b
unsafeFoldRing Ptr a
ptr b -> a -> b
f b
z Ring{Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} =
    let !res :: b
res = IO b -> b
forall a. IO a -> a
unsafeInlineIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ringStart ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
                    b -> Ptr a -> Ptr a -> IO b
go b
z Ptr a
p Ptr a
ptr
    in b
res
    where
      go :: b -> Ptr a -> Ptr a -> IO b
go !b
acc !Ptr a
p !Ptr a
q
        | Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
q = b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
        | Bool
otherwise = do
            a
x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
            b -> Ptr a -> Ptr a -> IO b
go (b -> a -> b
f b
acc a
x) (PTR_NEXT(p,a)) q

-- XXX Can we remove MonadIO here?
withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtrM :: ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtrM ForeignPtr a
fp Ptr a -> m b
fn = do
    b
r <- Ptr a -> m b
fn (Ptr a -> m b) -> Ptr a -> m b
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
fp
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

-- | Like unsafeFoldRing but with a monadic step function.
{-# INLINE unsafeFoldRingM #-}
unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a)
    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingM :: Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingM Ptr a
ptr b -> a -> m b
f b
z Ring {Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} =
    ForeignPtr a -> (Ptr a -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtrM ForeignPtr a
ringStart ((Ptr a -> m b) -> m b) -> (Ptr a -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \Ptr a
x -> b -> Ptr a -> Ptr a -> m b
go b
z Ptr a
x Ptr a
ptr
  where
    go :: b -> Ptr a -> Ptr a -> m b
go !b
acc !Ptr a
start !Ptr a
end
        | Ptr a
start Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
end = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
        | Bool
otherwise = do
            let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
start
            b
acc1 <- b -> a -> m b
f b
acc a
x
            b -> Ptr a -> Ptr a -> m b
go b
acc1 (PTR_NEXT(start,a)) end

-- | Fold the entire length of a ring buffer starting at the supplied ringHead
-- pointer.  Assuming the supplied ringHead pointer points to the oldest item,
-- this would fold the ring starting from the oldest item to the newest item in
-- the ring.
--
-- Note, this will crash on ring of 0 size.
--
{-# INLINE unsafeFoldRingFullM #-}
unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a)
    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingFullM :: Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingFullM Ptr a
rh b -> a -> m b
f b
z rb :: Ring a
rb@Ring {Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} =
    ForeignPtr a -> (Ptr a -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtrM ForeignPtr a
ringStart ((Ptr a -> m b) -> m b) -> (Ptr a -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \Ptr a
_ -> b -> Ptr a -> m b
go b
z Ptr a
rh
  where
    go :: b -> Ptr a -> m b
go !b
acc !Ptr a
start = do
        let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
start
        b
acc' <- b -> a -> m b
f b
acc a
x
        let ptr :: Ptr a
ptr = Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
advance Ring a
rb Ptr a
start
        if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
rh
            then b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'
            else b -> Ptr a -> m b
go b
acc' Ptr a
ptr

-- | Fold @Int@ items in the ring starting at @Ptr a@.  Won't fold more
-- than the length of the ring.
--
-- Note, this will crash on ring of 0 size.
--
{-# INLINE unsafeFoldRingNM #-}
unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a)
    => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingNM :: Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingNM Int
count Ptr a
rh b -> a -> m b
f b
z rb :: Ring a
rb@Ring {Ptr a
ForeignPtr a
ringBound :: Ptr a
ringStart :: ForeignPtr a
ringBound :: forall a. Ring a -> Ptr a
ringStart :: forall a. Ring a -> ForeignPtr a
..} =
    ForeignPtr a -> (Ptr a -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
ForeignPtr a -> (Ptr a -> m b) -> m b
withForeignPtrM ForeignPtr a
ringStart ((Ptr a -> m b) -> m b) -> (Ptr a -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \Ptr a
_ -> Int -> b -> Ptr a -> m b
forall t. (Eq t, Num t) => t -> b -> Ptr a -> m b
go Int
count b
z Ptr a
rh

    where

    go :: t -> b -> Ptr a -> m b
go t
0 b
acc Ptr a
_ = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
    go !t
n !b
acc !Ptr a
start = do
        let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
start
        b
acc' <- b -> a -> m b
f b
acc a
x
        let ptr :: Ptr a
ptr = Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
advance Ring a
rb Ptr a
start
        if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
rh Bool -> Bool -> Bool
|| t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
            then b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'
            else t -> b -> Ptr a -> m b
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) b
acc' Ptr a
ptr

data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Int -> Tuple4' a b c d -> ShowS
[Tuple4' a b c d] -> ShowS
Tuple4' a b c d -> [Char]
(Int -> Tuple4' a b c d -> ShowS)
-> (Tuple4' a b c d -> [Char])
-> ([Tuple4' a b c d] -> ShowS)
-> Show (Tuple4' a b c d)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall a b c d.
(Show a, Show b, Show c, Show d) =>
Int -> Tuple4' a b c d -> ShowS
forall a b c d.
(Show a, Show b, Show c, Show d) =>
[Tuple4' a b c d] -> ShowS
forall a b c d.
(Show a, Show b, Show c, Show d) =>
Tuple4' a b c d -> [Char]
showList :: [Tuple4' a b c d] -> ShowS
$cshowList :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
[Tuple4' a b c d] -> ShowS
show :: Tuple4' a b c d -> [Char]
$cshow :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
Tuple4' a b c d -> [Char]
showsPrec :: Int -> Tuple4' a b c d -> ShowS
$cshowsPrec :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
Int -> Tuple4' a b c d -> ShowS
Show

-- | 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.
{-# INLINE slidingWindowWith #-}
slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)
    => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith :: 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) = (Tuple4' (Ring a) (Ptr a) Int s
 -> a -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b))
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
-> (Tuple4' (Ring a) (Ptr a) Int 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) -> Fold m a b
Fold Tuple4' (Ring a) (Ptr a) Int s
-> a -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
step m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
initial Tuple4' (Ring a) (Ptr a) Int s -> m b
forall a b c. Tuple4' a b c s -> m b
extract

    where

    initial :: m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
initial = do
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then [Char] -> m (Step (Tuple4' (Ring a) (Ptr a) Int 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
            (Ring a
rb, Ptr a
rh) <- IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ring a, Ptr a) -> m (Ring a, Ptr a))
-> IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ring a, Ptr a)
forall a. Storable a => Int -> IO (Ring a, Ptr a)
new Int
n
            Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple4' (Ring a) (Ptr a) Int s) b
 -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b))
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall a b. (a -> b) -> a -> b
$
                case Step s b
r of
                    Partial s
s -> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. s -> Step s b
Partial (Tuple4' (Ring a) (Ptr a) Int s
 -> Step (Tuple4' (Ring a) (Ptr a) Int s) b)
-> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> Int -> s -> Tuple4' (Ring a) (Ptr a) Int s
forall a b c d. a -> b -> c -> d -> Tuple4' a b c d
Tuple4' Ring a
rb Ptr a
rh (Int
0 :: Int) s
s
                    Done b
b -> b -> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. b -> Step s b
Done b
b

    toArray :: (t
 -> (MutArray a -> a -> m (MutArray a)) -> MutArray a -> t -> m b)
-> t -> t -> m b
toArray t -> (MutArray a -> a -> m (MutArray a)) -> MutArray a -> t -> m b
foldRing t
rb t
rh = do
        MutArray a
arr <- IO (MutArray a) -> m (MutArray 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)
MA.newPinned Int
n
        let snoc' :: MutArray a -> a -> m (MutArray a)
snoc' MutArray a
b a
a = IO (MutArray a) -> m (MutArray 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
$ MutArray a -> a -> IO (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
MA.snocUnsafe MutArray a
b a
a
        t -> (MutArray a -> a -> m (MutArray a)) -> MutArray a -> t -> m b
foldRing t
rh MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snoc' MutArray a
arr t
rb

    step :: Tuple4' (Ring a) (Ptr a) Int s
-> a -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
step (Tuple4' Ring a
rb Ptr a
rh Int
i s
st) a
a
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = do
            Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> m (Ptr a)) -> IO (Ptr a) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
unsafeInsert Ring a
rb Ptr a
rh a
a
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (Ring a -> ForeignPtr a
forall a. Ring a -> ForeignPtr a
ringStart Ring a
rb)
            let action :: m (MutArray a)
action = (Ptr a
 -> (MutArray a -> a -> m (MutArray a))
 -> MutArray a
 -> Ring a
 -> m (MutArray a))
-> Ring a -> Ptr a -> m (MutArray a)
forall (m :: * -> *) (m :: * -> *) a a t t b.
(MonadIO m, MonadIO m, Unbox a, Unbox a) =>
(t
 -> (MutArray a -> a -> m (MutArray a)) -> MutArray a -> t -> m b)
-> t -> t -> m b
toArray Ptr a
-> (MutArray a -> a -> m (MutArray a))
-> MutArray a
-> Ring a
-> m (MutArray a)
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingM Ring a
rb (PTR_NEXT(rh, 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), m (MutArray a)
action)
            Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple4' (Ring a) (Ptr a) Int s) b
 -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b))
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall a b. (a -> b) -> a -> b
$
                case Step s b
r of
                    Partial s
s -> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. s -> Step s b
Partial (Tuple4' (Ring a) (Ptr a) Int s
 -> Step (Tuple4' (Ring a) (Ptr a) Int s) b)
-> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> Int -> s -> Tuple4' (Ring a) (Ptr a) Int s
forall a b c d. a -> b -> c -> d -> Tuple4' a b c d
Tuple4' Ring a
rb Ptr a
rh1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s
                    Done b
b -> b -> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. b -> Step s b
Done b
b
        | Bool
otherwise = do
            a
old <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
            Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> m (Ptr a)) -> IO (Ptr a) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
unsafeInsert Ring a
rb Ptr a
rh a
a
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (Ring a -> ForeignPtr a
forall a. Ring a -> ForeignPtr a
ringStart Ring a
rb)
            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), (Ptr a
 -> (MutArray a -> a -> m (MutArray a))
 -> MutArray a
 -> Ring a
 -> m (MutArray a))
-> Ring a -> Ptr a -> m (MutArray a)
forall (m :: * -> *) (m :: * -> *) a a t t b.
(MonadIO m, MonadIO m, Unbox a, Unbox a) =>
(t
 -> (MutArray a -> a -> m (MutArray a)) -> MutArray a -> t -> m b)
-> t -> t -> m b
toArray Ptr a
-> (MutArray a -> a -> m (MutArray a))
-> MutArray a
-> Ring a
-> m (MutArray a)
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
unsafeFoldRingFullM Ring a
rb Ptr a
rh1)
            Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple4' (Ring a) (Ptr a) Int s) b
 -> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b))
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
-> m (Step (Tuple4' (Ring a) (Ptr a) Int s) b)
forall a b. (a -> b) -> a -> b
$
                case Step s b
r of
                    Partial s
s -> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. s -> Step s b
Partial (Tuple4' (Ring a) (Ptr a) Int s
 -> Step (Tuple4' (Ring a) (Ptr a) Int s) b)
-> Tuple4' (Ring a) (Ptr a) Int s
-> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> Int -> s -> Tuple4' (Ring a) (Ptr a) Int s
forall a b c d. a -> b -> c -> d -> Tuple4' a b c d
Tuple4' Ring a
rb Ptr a
rh1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s
                    Done b
b -> b -> Step (Tuple4' (Ring a) (Ptr a) Int s) b
forall s b. b -> Step s b
Done b
b

    extract :: Tuple4' a b c s -> m b
extract (Tuple4' a
_ b
_ c
_ s
st) = s -> m b
extract1 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.
--
{-# INLINE slidingWindow #-}
slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a)
    => Int -> Fold m (a, Maybe a) b -> Fold m a b
slidingWindow :: 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, Storable a, 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)