{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE UnboxedTuples #-}
#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Array
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : pre-release
-- Portability : GHC
--
module Streamly.Internal.Data.Array
    ( Array(..)

    -- * Construction
    , nil
    , writeN
    , write
    , writeLastN

    , fromStreamDN
    , fromStreamD
    , fromStreamN
    , fromStream

    , fromListN
    , fromList

    -- * Elimination
    , length
    , read

    , toStreamD
    , toStreamDRev
    , toStream
    , toStreamRev

    , foldl'
    , foldr
    , streamFold
    , fold

    -- * Random Access
    , getIndexUnsafe
    , strip
    )
where

#if !MIN_VERSION_primitive(0,7,1)
import Control.DeepSeq (NFData(..))
#endif
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Functor.Identity (runIdentity)
import Data.IORef
import GHC.Base (Int(..))
import GHC.IO (unsafePerformIO)

import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Stream.Serial (SerialT(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

import qualified GHC.Exts as Exts
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Ring as RB
import qualified Streamly.Internal.Data.Stream.StreamD as D

import Data.Primitive.Array hiding (fromList, fromListN)
import Prelude hiding (foldr, length, read)

{-# NOINLINE bottomElement #-}
bottomElement :: a
bottomElement :: forall a. a
bottomElement = forall a. HasCallStack => a
undefined

{-# NOINLINE nil #-}
nil :: Array a
nil :: forall a. Array a
nil = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    MutableArray RealWorld a
marr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 forall a. a
bottomElement
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
marr Int
0 Int
0

-------------------------------------------------------------------------------
-- Construction - Folds
-------------------------------------------------------------------------------

{-# INLINE_NORMAL writeN #-}
writeN :: MonadIO m => Int -> Fold m a (Array a)
writeN :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeN Int
len = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a}.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
step forall {a}.
m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
initial forall {m :: * -> *} {a}.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract

    where

    {-# INLINE next #-}
    next :: MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr Int
i = do
        let i1 :: Int
i1 = Int
i forall a. Num a => a -> a -> a
+ Int
1
            st :: Tuple' (MutableArray RealWorld a) Int
st = forall a b. a -> b -> Tuple' a b
Tuple' MutableArray RealWorld a
marr Int
i1
        if Int
len forall a. Ord a => a -> a -> Bool
> Int
i1
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial Tuple' (MutableArray RealWorld a) Int
st
        else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s b. b -> Step s b
FL.Done forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract Tuple' (MutableArray RealWorld a) Int
st

    initial :: m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
initial = do
        MutableArray RealWorld a
marr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
len forall a. a
bottomElement
        forall {m :: * -> *} {a}.
MonadIO m =>
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr (-Int
1)

    step :: Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
step (Tuple' MutableArray RealWorld a
marr Int
i) a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
marr Int
i a
x
        forall {m :: * -> *} {a}.
MonadIO m =>
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr Int
i

    extract :: Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract (Tuple' MutableArray RealWorld a
marr Int
l) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
marr Int
0 Int
l

{-# INLINE_NORMAL write #-}
write :: MonadIO m => Fold m a (Array a)
write :: forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a} {b}.
MonadIO m =>
Tuple3' (MutableArray RealWorld a) Int Int
-> a -> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
step forall {a} {b}.
m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
initial forall {m :: * -> *} {a} {c}.
MonadIO m =>
Tuple3' (MutableArray RealWorld a) Int c -> m (Array a)
extract
  where
    initial :: m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
initial = do
        MutableArray RealWorld a
marr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 forall a. a
bottomElement
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
marr Int
0 Int
0)
    step :: Tuple3' (MutableArray RealWorld a) Int Int
-> a -> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
step (Tuple3' MutableArray RealWorld a
marr Int
i Int
capacity) a
x
        | Int
i forall a. Eq a => a -> a -> Bool
== Int
capacity =
            let newCapacity :: Int
newCapacity = forall a. Ord a => a -> a -> a
max (Int
capacity forall a. Num a => a -> a -> a
* Int
2) Int
1
             in do MutableArray RealWorld a
newMarr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
newCapacity forall a. a
bottomElement
                   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
newMarr Int
0 MutableArray RealWorld a
marr Int
0 Int
i
                   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
newMarr Int
i a
x
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
newMarr (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
newCapacity
        | Bool
otherwise = do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
marr Int
i a
x
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
marr (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
capacity
    extract :: Tuple3' (MutableArray RealWorld a) Int c -> m (Array a)
extract (Tuple3' MutableArray RealWorld a
marr Int
len c
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
marr Int
0 Int
len

-------------------------------------------------------------------------------
-- Construction - from streams
-------------------------------------------------------------------------------

{-# INLINE_NORMAL fromStreamDN #-}
fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (Array a)
fromStreamDN :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
limit Stream m a
str = do
    MutableArray RealWorld a
marr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (forall a. Ord a => a -> a -> a
max Int
limit Int
0) forall a. a
bottomElement
    Int
i <-
        forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Stream m a -> m b
D.foldlM'
            (\Int
i a
x -> Int
i seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
marr Int
i a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i forall a. Num a => a -> a -> a
+ Int
1))
            (forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
Applicative m =>
Int -> Stream m a -> Stream m a
D.take Int
limit Stream m a
str
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
marr Int
0 Int
i

{-# INLINE fromStreamD #-}
fromStreamD :: MonadIO m => D.Stream m a -> m (Array a)
fromStreamD :: forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStreamD = forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write

{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> SerialT m a -> m (Array a)
fromStreamN :: forall (m :: * -> *) a.
MonadIO m =>
Int -> SerialT m a -> m (Array a)
fromStreamN Int
n (SerialT Stream m a
m) = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"fromStreamN: negative write count specified"
    forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Stream m a -> Stream m a
D.fromStreamK Stream m a
m

{-# INLINE fromStream #-}
fromStream :: MonadIO m => SerialT m a -> m (Array a)
fromStream :: forall (m :: * -> *) a. MonadIO m => SerialT m a -> m (Array a)
fromStream (SerialT Stream m a
m) = forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStreamD forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Stream m a -> Stream m a
D.fromStreamK Stream m a
m

{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> Array a
fromListN :: forall a. Int -> [a] -> Array a
fromListN Int
n [a]
xs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

{-# INLINABLE fromList #-}
fromList :: [a] -> Array a
fromList :: forall a. [a] -> Array a
fromList [a]
xs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStreamD forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-------------------------------------------------------------------------------
-- Elimination - Unfolds
-------------------------------------------------------------------------------

{-# INLINE length #-}
length :: Array a -> Int
length :: forall a. Array a -> Int
length = forall a. Array a -> Int
sizeofArray

{-# INLINE_NORMAL read #-}
read :: Monad m => Unfold m (Array a) a
read :: forall (m :: * -> *) a. Monad m => Unfold m (Array a) a
read = forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold forall {m :: * -> *} {a}.
Monad m =>
(Array a, Int) -> m (Step (Array a, Int) a)
step forall {m :: * -> *} {b} {a}. (Monad m, Num b) => a -> m (a, b)
inject
  where
    inject :: a -> m (a, b)
inject a
arr = forall (m :: * -> *) a. Monad m => a -> m a
return (a
arr, b
0)
    step :: (Array a, Int) -> m (Step (Array a, Int) a)
step (Array a
arr, Int
i)
        | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
length Array a
arr = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
    step (Array a
arr, I# Int#
i) =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
            (# a
x #) -> forall s a. a -> s -> Step s a
D.Yield a
x (Array a
arr, Int# -> Int
I# Int#
i forall a. Num a => a -> a -> a
+ Int
1)

-------------------------------------------------------------------------------
-- Elimination - to streams
-------------------------------------------------------------------------------

{-# INLINE_NORMAL toStreamD #-}
toStreamD :: Monad m => Array a -> D.Stream m a
toStreamD :: forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream forall {m :: * -> *} {p}. Monad m => p -> Int -> m (Step Int a)
step Int
0
  where
    {-# INLINE_LATE step #-}
    step :: p -> Int -> m (Step Int a)
step p
_ Int
i
        | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
length Array a
arr = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
    step p
_ (I# Int#
i) =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
            (# a
x #) -> forall s a. a -> s -> Step s a
D.Yield a
x (Int# -> Int
I# Int#
i forall a. Num a => a -> a -> a
+ Int
1)

{-# INLINE_NORMAL toStreamDRev #-}
toStreamDRev :: Monad m => Array a -> D.Stream m a
toStreamDRev :: forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamDRev Array a
arr = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream forall {m :: * -> *} {p}. Monad m => p -> Int -> m (Step Int a)
step (forall a. Array a -> Int
length Array a
arr forall a. Num a => a -> a -> a
- Int
1)
  where
    {-# INLINE_LATE step #-}
    step :: p -> Int -> m (Step Int a)
step p
_ Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
    step p
_ (I# Int#
i) =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
            (# a
x #) -> forall s a. a -> s -> Step s a
D.Yield a
x (Int# -> Int
I# Int#
i forall a. Num a => a -> a -> a
- Int
1)

{-# INLINE_EARLY toStream #-}
toStream :: Monad m => Array a -> SerialT m a
toStream :: forall (m :: * -> *) a. Monad m => Array a -> SerialT m a
toStream = forall (m :: * -> *) a. Stream m a -> SerialT m a
SerialT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Stream m a -> Stream m a
D.toStreamK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD

{-# INLINE_EARLY toStreamRev #-}
toStreamRev :: Monad m => Array a -> SerialT m a
toStreamRev :: forall (m :: * -> *) a. Monad m => Array a -> SerialT m a
toStreamRev = forall (m :: * -> *) a. Stream m a -> SerialT m a
SerialT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Stream m a -> Stream m a
D.toStreamK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamDRev

-------------------------------------------------------------------------------
-- Elimination - using Folds
-------------------------------------------------------------------------------

{-# INLINE_NORMAL foldl' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f b
z Array a
arr = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr

{-# INLINE_NORMAL foldr #-}
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
z Array a
arr = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr

#if !MIN_VERSION_primitive(0,7,1)
instance NFData a => NFData (Array a) where
    {-# INLINE rnf #-}
    rnf = foldl' (\_ x -> rnf x) ()
#endif

{-# INLINE fold #-}
fold :: Monad m => Fold m a b -> Array a -> m b
fold :: forall (m :: * -> *) a b. Monad m => Fold m a b -> Array a -> m b
fold Fold m a b
f Array a
arr = forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a b
f (forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr)

{-# INLINE streamFold #-}
streamFold :: Monad m => (SerialT m a -> m b) -> Array a -> m b
streamFold :: forall (m :: * -> *) a b.
Monad m =>
(SerialT m a -> m b) -> Array a -> m b
streamFold SerialT m a -> m b
f Array a
arr = SerialT m a -> m b
f (forall (m :: * -> *) a. Monad m => Array a -> SerialT m a
toStream Array a
arr)

-------------------------------------------------------------------------------
-- Random reads and writes
-------------------------------------------------------------------------------

-- | /O(1)/ Lookup the element at the given index. Index starts from 0. Does
-- not check the bounds.
--
-- @since 0.8.0
{-# INLINE getIndexUnsafe #-}
getIndexUnsafe :: Array a -> Int -> a
getIndexUnsafe :: forall a. Array a -> Int -> a
getIndexUnsafe = forall a. Array a -> Int -> a
indexArray

{-# INLINE writeLastN #-}
writeLastN :: MonadIO m => Int -> Fold m a (Array a)
writeLastN :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeLastN Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
    | Bool
otherwise = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a} {b}.
MonadIO m =>
Tuple' (Ring a) Int -> a -> m (Step (Tuple' (Ring a) Int) b)
step forall {a} {b}. m (Step (Tuple' (Ring a) Int) b)
initial forall {m :: * -> *} {a}.
MonadIO m =>
Tuple' (Ring a) Int -> m (Array a)
done

    where

    initial :: m (Step (Tuple' (Ring a) Int) b)
initial = do
        Ring a
rb <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Int -> IO (Ring a)
RB.createRing Int
n
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Ring a
rb (Int
0 :: Int)

    step :: Tuple' (Ring a) Int -> a -> m (Step (Tuple' (Ring a) Int) b)
step (Tuple' Ring a
rb Int
rh) a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Ring a -> Int -> a -> IO ()
RB.unsafeInsertRing Ring a
rb Int
rh a
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Ring a
rb (Int
rh forall a. Num a => a -> a -> a
+ Int
1)

    done :: Tuple' (Ring a) Int -> m (Array a)
done (Tuple' Ring a
rb Int
rh) = do
        MutableArray RealWorld a
arr' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (forall a. Ord a => a -> a -> a
min Int
rh Int
n) (forall a. HasCallStack => a
undefined :: a)
        Int
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall a. Ring a -> IORef Int
RB.ringHead Ring a
rb
        if Int
rh forall a. Ord a => a -> a -> Bool
< Int
n
        then
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
arr' Int
0 (forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
0 Int
ref
        else do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
arr' Int
0 (forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
ref (Int
n forall a. Num a => a -> a -> a
- Int
ref)
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
arr' (Int
n forall a. Num a => a -> a -> a
- Int
ref) (forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
0 Int
ref
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray RealWorld a
arr'

-- XXX This is not efficient as it copies the array. We should support array
-- slicing so that we can just refer to the underlying array memory instead of
-- copying.
--
-- | Truncate the array at the beginning and end as long as the predicate
-- holds true.
strip :: (a -> Bool) -> Array a -> Array a
strip :: forall a. (a -> Bool) -> Array a -> Array a
strip a -> Bool
p Array a
arr =
    let lastIndex :: Int
lastIndex = forall a. Array a -> Int
length Array a
arr forall a. Num a => a -> a -> a
- Int
1
        indexR :: Int
indexR = Int -> Int
getIndexR Int
lastIndex -- last predicate failing index
    in if Int
indexR forall a. Eq a => a -> a -> Bool
== -Int
1
       then forall a. Array a
nil
       else
            let indexL :: Int
indexL = Int -> Int
getIndexL Int
0 -- first predicate failing index
            in if Int
indexL forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
indexR forall a. Eq a => a -> a -> Bool
== Int
lastIndex
               then Array a
arr
               else forall a. Array a -> Int -> Int -> Array a
cloneArray Array a
arr Int
indexL (Int
indexR forall a. Num a => a -> a -> a
- Int
indexL forall a. Num a => a -> a -> a
+ Int
1)

    where

    getIndexR :: Int -> Int
getIndexR Int
idx
        | Int
idx forall a. Ord a => a -> a -> Bool
< Int
0 = Int
idx
        | Bool
otherwise =
            if a -> Bool
p (forall a. Array a -> Int -> a
indexArray Array a
arr Int
idx) then Int -> Int
getIndexR (Int
idx forall a. Num a => a -> a -> a
- Int
1) else Int
idx

    getIndexL :: Int -> Int
getIndexL Int
idx = if a -> Bool
p (forall a. Array a -> Int -> a
indexArray Array a
arr Int
idx) then Int -> Int
getIndexL (Int
idx forall a. Num a => a -> a -> a
+ Int
1) else Int
idx