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

    -- * Conversion
    , unsafeFreeze
    , unsafeThaw

    -- * Construction
    , nil
    , createOf
    , create
    , createWith
    , createOfLast

    , fromStreamN
    , fromStream
    , fromPureStream
    , fromCString#

    , fromListN
    , fromList

    , chunksOf

    -- * Elimination
    , length
    , reader

    , toList
    , read
    , readRev

    , foldl'
    , foldr
    , streamFold
    , fold

    -- * Random Access
    , unsafeGetIndex
    , getIndex
    , unsafeSliceOffLen
    , dropAround

    -- * Parsing Stream of Arrays
    , toParserK

    -- * Deprecated
    , strip
    , getIndexUnsafe
    , getSliceUnsafe
    , writeN
    , write
    , fromByteStr#
    )
where

#include "inline.hs"
#include "assert.hs"
#include "deprecation.h"

import Control.Monad (replicateM)
import Control.Monad.IO.Class (MonadIO)
import Data.Functor.Identity (Identity(..))
import Data.Word (Word8)
import GHC.Base (MutableArray#, RealWorld)
import GHC.Exts (Addr#)
import GHC.Types (SPEC(..))
import GHC.IO (unsafePerformIO)
import Text.Read (readPrec)

import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.ParserK.Type
    (ParserK, ParseResult(..), Input(..), Step(..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)

import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.MutArray.Generic as MArray
import qualified Streamly.Internal.Data.Parser.Type as ParserD
import qualified Streamly.Internal.Data.ParserK.Type as ParserK
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.RingArray.Generic as RB
import qualified Streamly.Internal.Data.Stream.Type as D
import qualified Streamly.Internal.Data.Stream.Generate as D
import qualified Text.ParserCombinators.ReadPrec as ReadPrec

import Prelude hiding (Foldable(..), read)

-------------------------------------------------------------------------------
-- Array Data Type
-------------------------------------------------------------------------------

data Array a =
    Array
        { forall a. Array a -> MutableArray# RealWorld a
arrContents# :: MutableArray# RealWorld a
          -- ^ The internal contents of the array representing the entire array.

        , forall a. Array a -> Int
arrStart :: {-# UNPACK #-}!Int
          -- ^ The starting index of this slice.

        , forall a. Array a -> Int
arrEnd :: {-# UNPACK #-}!Int
          -- ^ First invalid index of the array.
        }

unsafeFreeze :: MArray.MutArray a -> Array a
unsafeFreeze :: forall a. MutArray a -> Array a
unsafeFreeze (MArray.MutArray MutableArray# RealWorld a
cont# Int
arrS Int
arrE Int
_) = MutableArray# RealWorld a -> Int -> Int -> Array a
forall a. MutableArray# RealWorld a -> Int -> Int -> Array a
Array MutableArray# RealWorld a
cont# Int
arrS Int
arrE

unsafeThaw :: Array a -> MArray.MutArray a
unsafeThaw :: forall a. Array a -> MutArray a
unsafeThaw (Array MutableArray# RealWorld a
cont# Int
arrS Int
arrE) = MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
forall a.
MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
MArray.MutArray MutableArray# RealWorld a
cont# Int
arrS Int
arrE Int
arrE

{-# NOINLINE nil #-}
nil :: Array a
nil :: forall a. Array a
nil = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a) -> IO (MutArray a) -> IO (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => m (MutArray a)
MArray.nil

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

{-# INLINE_NORMAL createOf #-}
createOf :: MonadIO m => Int -> Fold m a (Array a)
createOf :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createOf = (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (Fold m a (MutArray a) -> Fold m a (Array a))
-> (Int -> Fold m a (MutArray a)) -> Int -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
MArray.createOf

{-# DEPRECATED writeN "Please use createOf instead." #-}
{-# INLINE writeN #-}
writeN :: MonadIO m => Int -> Fold m a (Array a)
writeN :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeN = Int -> Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createOf

{-# INLINE_NORMAL createWith #-}
createWith :: MonadIO m => Int -> Fold m a (Array a)
createWith :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createWith Int
elemCount = MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
MArray.createWith Int
elemCount

-- | Fold the whole input to a single array.
--
-- /Caution! Do not use this on infinite streams./
--
{-# INLINE create #-}
create :: MonadIO m => Fold m a (Array a)
create :: forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
create = (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Fold m a (MutArray a)
MArray.create

{-# DEPRECATED write "Please use create instead." #-}
{-# INLINE write #-}
write :: MonadIO m => Fold m a (Array a)
write :: forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write = Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
create

fromPureStream :: Stream Identity a -> Array a
fromPureStream :: forall a. Stream Identity a -> Array a
fromPureStream Stream Identity a
x =
    IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ (MutArray a -> Array a) -> IO (MutArray a) -> IO (Array a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (Stream Identity a -> IO (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Stream Identity a -> m (MutArray a)
MArray.fromPureStream Stream Identity a
x)
-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)
-- fromPureStream = fromList . runIdentity . D.toList

fromCString# :: MonadIO m => Addr# -> m (Array Word8)
fromCString# :: forall (m :: * -> *). MonadIO m => Addr# -> m (Array Word8)
fromCString# Addr#
addr = Stream m Word8 -> m (Array Word8)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStream (Stream m Word8 -> m (Array Word8))
-> Stream m Word8 -> m (Array Word8)
forall a b. (a -> b) -> a -> b
$ Addr# -> Stream m Word8
forall (m :: * -> *). Monad m => Addr# -> Stream m Word8
D.fromCString# Addr#
addr

{-# DEPRECATED fromByteStr# "Please use 'unsafePerformIO . fromCString#' instead" #-}
fromByteStr# :: Addr# -> Array Word8
fromByteStr# :: Addr# -> Array Word8
fromByteStr# Addr#
addr = Stream Identity Word8 -> Array Word8
forall a. Stream Identity a -> Array a
fromPureStream (Addr# -> Stream Identity Word8
forall (m :: * -> *). Monad m => Addr# -> Stream m Word8
D.fromCString# Addr#
addr)

-------------------------------------------------------------------------------
-- Stream Ops
-------------------------------------------------------------------------------

{-# INLINE_NORMAL chunksOf #-}
chunksOf :: forall m a. MonadIO m
    => Int -> Stream m a -> Stream m (Array a)
chunksOf :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> Stream m (Array a)
chunksOf Int
n Stream m a
strm = (MutArray a -> Array a)
-> Stream m (MutArray a) -> Stream m (Array a)
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (Stream m (MutArray a) -> Stream m (Array a))
-> Stream m (MutArray a) -> Stream m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m a -> Stream m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> Stream m (MutArray a)
MArray.chunksOf Int
n Stream m a
strm

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

{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a)
fromStreamN :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamN Int
n = Fold m a (Array a) -> Stream m a -> m (Array a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold (Int -> Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeN Int
n)

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

-- XXX Consider foldr/build fusion in toList/fromList

{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> Array a
fromListN :: forall a. Int -> [a] -> Array a
fromListN Int
n [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> Stream IO a -> IO (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamN Int
n (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
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 = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Stream IO a -> IO (Array a)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStream (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
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 Array a
arr = Array a -> Int
forall a. Array a -> Int
arrEnd Array a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Array a -> Int
forall a. Array a -> Int
arrStart Array a
arr

{-# INLINE_NORMAL reader #-}
reader :: Monad m => Unfold m (Array a) a
reader :: forall (m :: * -> *) a. Monad m => Unfold m (Array a) a
reader =
    Producer m (Array a) a -> Unfold m (Array a) a
forall (m :: * -> *) a b. Producer m a b -> Unfold m a b
Producer.simplify
        (Producer m (Array a) a -> Unfold m (Array a) a)
-> Producer m (Array a) a -> Unfold m (Array a) a
forall a b. (a -> b) -> a -> b
$ (Array a -> MutArray a)
-> (MutArray a -> Array a)
-> Producer m (MutArray a) a
-> Producer m (Array a) a
forall (m :: * -> *) a c b.
Functor m =>
(a -> c) -> (c -> a) -> Producer m c b -> Producer m a b
Producer.translate Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze
        (Producer m (MutArray a) a -> Producer m (Array a) a)
-> Producer m (MutArray a) a -> Producer m (Array a) a
forall a b. (a -> b) -> a -> b
$ (forall b. IO b -> m b) -> Producer m (MutArray a) a
forall (m :: * -> *) a.
Monad m =>
(forall b. IO b -> m b) -> Producer m (MutArray a) a
MArray.producerWith (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (IO b -> b) -> IO b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> b
forall a. IO a -> a
unsafeInlineIO)

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

{-# INLINE_NORMAL toList #-}
toList :: Array a -> [a]
toList :: forall a. Array a -> [a]
toList Array a
arr = Int -> [a]
loop Int
0

    where

    len :: Int
len = Array a -> Int
forall a. Array a -> Int
length Array a
arr
    loop :: Int -> [a]
loop Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = []
    loop Int
i = Int -> Array a -> a
forall a. Int -> Array a -> a
unsafeGetIndex Int
i Array a
arr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{-# INLINE_NORMAL read #-}
read :: Monad m => Array a -> Stream m a
read :: forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr =
    (Int -> a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map (Int -> Array a -> a
forall a. Int -> Array a -> a
`unsafeGetIndex` Array a
arr) (Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> Stream m a
D.enumerateFromToIntegral Int
0 (Array a -> Int
forall a. Array a -> Int
length Array a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

{-# INLINE_NORMAL readRev #-}
readRev :: Monad m => Array a -> Stream m a
readRev :: forall (m :: * -> *) a. Monad m => Array a -> Stream m a
readRev Array a
arr =
    (Int -> a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map (Int -> Array a -> a
forall a. Int -> Array a -> a
`unsafeGetIndex` Array a
arr)
        (Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> a -> Stream m a
D.enumerateFromThenToIntegral (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
0
    where
    arrLen :: Int
arrLen = Array a -> Int
forall a. Array a -> Int
length Array a
arr

-------------------------------------------------------------------------------
-- 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 = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> b -> Stream IO a -> IO b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z (Stream IO a -> IO b) -> Stream IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream IO a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read 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 = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> Stream IO a -> IO b
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z (Stream IO a -> IO b) -> Stream IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream IO a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr

{-# 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 = Fold m a b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a b
f (Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr)

{-# INLINE streamFold #-}
streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b
streamFold :: forall (m :: * -> *) a b.
Monad m =>
(Stream m a -> m b) -> Array a -> m b
streamFold Stream m a -> m b
f Array a
arr = Stream m a -> m b
f (Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read 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 unsafeGetIndex #-}
unsafeGetIndex, getIndexUnsafe :: Int -> Array a -> a
unsafeGetIndex :: forall a. Int -> Array a -> a
unsafeGetIndex Int
i Array a
arr =
    IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> IO a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
MArray.unsafeGetIndex Int
i (Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr)

-- | Lookup the element at the given index. Index starts from 0.
--
{-# INLINE getIndex #-}
getIndex :: Int -> Array a -> Maybe a
getIndex :: forall a. Int -> Array a -> Maybe a
getIndex Int
i Array a
arr =
    if 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
< Array a -> Int
forall a. Array a -> Int
length Array a
arr
    then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> a
forall a. Int -> Array a -> a
unsafeGetIndex Int
i Array a
arr
    else Maybe a
forall a. Maybe a
Nothing

-- >>> import qualified Streamly.Data.Stream as Stream
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Array.Generic as Array
-- >>> import Data.Function ((&))
-- >>> :{
--  Stream.fromList [1,2,3,4,5::Int]
--      & Stream.scan (Array.createOfLast 2)
--      & Stream.fold Fold.toList
--  :}
-- [fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]
--
{-# INLINE createOfLast #-}
createOfLast :: MonadIO m => Int -> Fold m a (Array a)
createOfLast :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createOfLast Int
n = (RingArray a -> m (Array a))
-> Fold m a (RingArray a) -> Fold m a (Array a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
FL.rmapM RingArray a -> m (Array a)
forall {m :: * -> *} {a}. MonadIO m => RingArray a -> m (Array a)
f (Int -> Fold m a (RingArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (RingArray a)
RB.createOf Int
n)

    where

    f :: RingArray a -> m (Array a)
f RingArray a
rb = do
        MutArray a
arr <- Int -> Int -> RingArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Int -> RingArray a -> m (MutArray a)
RB.copyToMutArray Int
0 Int
n RingArray a
rb
        Array a -> m (Array a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze MutArray a
arr

{-# INLINE unsafeSliceOffLen #-}
unsafeSliceOffLen, getSliceUnsafe
    :: Int -> Int -> Array a -> Array a
unsafeSliceOffLen :: forall a. Int -> Int -> Array a -> Array a
unsafeSliceOffLen Int
offset Int
len =
    MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a)
-> (Array a -> MutArray a) -> Array a -> Array a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> MutArray a -> MutArray a
forall a. Int -> Int -> MutArray a -> MutArray a
MArray.unsafeSliceOffLen Int
offset Int
len (MutArray a -> MutArray a)
-> (Array a -> MutArray a) -> Array a -> MutArray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw

-- 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. Returns a slice of the original array.
{-# INLINE dropAround #-}
dropAround, strip :: (a -> Bool) -> Array a -> Array a
dropAround :: forall a. (a -> Bool) -> Array a -> Array a
dropAround a -> Bool
p Array a
arr =
    MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a) -> MutArray a -> Array a
forall a b. (a -> b) -> a -> b
$ IO (MutArray a) -> MutArray a
forall a. IO a -> a
unsafePerformIO (IO (MutArray a) -> MutArray a) -> IO (MutArray a) -> MutArray a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> MutArray a -> IO (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(a -> Bool) -> MutArray a -> m (MutArray a)
MArray.dropAround a -> Bool
p (Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

instance Eq a => Eq (Array a) where
    {-# INLINE (==) #-}
    Array a
arr1 == :: Array a -> Array a -> Bool
== Array a
arr2 =
        IO Bool -> Bool
forall a. IO a -> a
unsafeInlineIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$! Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr1 MutArray a -> MutArray a -> IO Bool
forall (m :: * -> *) a.
(MonadIO m, Eq a) =>
MutArray a -> MutArray a -> m Bool
`MArray.eq` Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr2

instance Ord a => Ord (Array a) where
    {-# INLINE compare #-}
    compare :: Array a -> Array a -> Ordering
compare Array a
arr1 Array a
arr2 =
        IO Ordering -> Ordering
forall a. IO a -> a
unsafeInlineIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$! Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr1 MutArray a -> MutArray a -> IO Ordering
forall (m :: * -> *) a.
(MonadIO m, Ord a) =>
MutArray a -> MutArray a -> m Ordering
`MArray.cmp` Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr2

    -- Default definitions defined in base do not have an INLINE on them, so we
    -- replicate them here with an INLINE.
    {-# INLINE (<) #-}
    Array a
x < :: Array a -> Array a -> Bool
<  Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
True;  Ordering
_ -> Bool
False }

    {-# INLINE (<=) #-}
    Array a
x <= :: Array a -> Array a -> Bool
<= Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
False; Ordering
_ -> Bool
True }

    {-# INLINE (>) #-}
    Array a
x > :: Array a -> Array a -> Bool
>  Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
True;  Ordering
_ -> Bool
False }

    {-# INLINE (>=) #-}
    Array a
x >= :: Array a -> Array a -> Bool
>= Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
False; Ordering
_ -> Bool
True }

    -- These two default methods use '<=' rather than 'compare'
    -- because the latter is often more expensive
    {-# INLINE max #-}
    max :: Array a -> Array a -> Array a
max Array a
x Array a
y = if Array a
x Array a -> Array a -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
y else Array a
x

    {-# INLINE min #-}
    min :: Array a -> Array a -> Array a
min Array a
x Array a
y = if Array a
x Array a -> Array a -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
x else Array a
y

instance Show a => Show (Array a) where
    {-# INLINE show #-}
    show :: Array a -> String
show Array a
arr = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (Array a -> [a]
forall a. Array a -> [a]
toList Array a
arr)

instance Read a => Read (Array a) where
    {-# INLINE readPrec #-}
    readPrec :: ReadPrec (Array a)
readPrec = do
        String
fromListWord <- Int -> ReadPrec Char -> ReadPrec String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
9 ReadPrec Char
ReadPrec.get
        if String
fromListWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fromList "
        then [a] -> Array a
forall a. [a] -> Array a
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
        else ReadPrec (Array a)
forall a. ReadPrec a
ReadPrec.pfail

-------------------------------------------------------------------------------
-- Backward Compatibility
-------------------------------------------------------------------------------

RENAME(strip,dropAround)
RENAME(getSliceUnsafe,unsafeSliceOffLen)
RENAME(getIndexUnsafe,unsafeGetIndex)

--------------------------------------------------------------------------------
-- Convert Parser to Parserk on Generic Arrays
--------------------------------------------------------------------------------

{-# INLINE adaptCGWith #-}
adaptCGWith
    :: forall m a s b r. (Monad m)
    => (s -> a -> m (ParserD.Step s b))
    -> m (ParserD.Initial s b)
    -> (s -> m (ParserD.Final s b))
    -> (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r))
    -> Int
    -> Int
    -> Input (Array a)
    -> m (Step (Array a) m r)
adaptCGWith :: forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Final s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCGWith s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Final s b)
extract ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont !Int
offset0 !Int
usedCount !Input (Array a)
input = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        ParserD.IPartial s
pst -> do
            case Input (Array a)
input of
                Chunk Array a
arr -> Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
usedCount Int
offset0 s
pst Array a
arr
                Input (Array a)
None -> Int -> s -> m (Step (Array a) m r)
parseContNothing Int
usedCount s
pst
        ParserD.IDone b
b -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
offset0 b
b) Int
usedCount Input (Array a)
input
        ParserD.IError String
err -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
offset0 String
err) Int
usedCount Input (Array a)
input

    where

    {-# NOINLINE parseContChunk #-}
    parseContChunk :: Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk !Int
count !Int
offset !s
state arr :: Array a
arr@(Array MutableArray# RealWorld a
contents Int
start Int
end) = do
         if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) s
state
         else Step (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
offset (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont Int
count s
state)

        where

        {-# INLINE onDone #-}
        onDone :: Int -> b -> m (Step (Array a) m r)
onDone Int
n b
b =
            Bool -> m (Step (Array a) m r) -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a -> Int
forall a. Array a -> Int
length Array a
arr)
                (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
n b
b) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr))

        {-# INLINE callParseCont #-}
        callParseCont :: (Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n s
pst1 =
            Bool -> m a -> m a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Array a -> Int
forall a. Array a -> Int
length Array a
arr)
                (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) s
pst1))

        {-# INLINE onPartial #-}
        onPartial :: Int -> s -> m (Step (Array a) m r)
onPartial = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial

        {-# INLINE onContinue #-}
        onContinue :: Int -> s -> m (Step (Array a) m r)
onContinue = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue

        {-# INLINE onError #-}
        onError :: Int -> String -> m (Step (Array a) m r)
onError Int
n String
err =
            ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
n String
err) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr)

        {-# INLINE onBack #-}
        onBack :: Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack Int
offset1 Int -> s -> m (Step (Array a) m r)
constr s
pst = do
            let pos :: Int
pos = Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
             in if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
offset1 s
pst
                else Int -> s -> m (Step (Array a) m r)
constr Int
pos s
pst

        go :: SPEC -> Int -> s -> m (Step (Array a) m r)
go !SPEC
_ !Int
cur !s
pst | Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step (Array a) m r)
onContinue (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)  s
pst
        go !SPEC
_ !Int
cur !s
pst = 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
$ MutableArray# RealWorld a -> Int -> IO a
forall (m :: * -> *) a.
MonadIO m =>
MutableArray# RealWorld a -> Int -> m a
MArray.unsafeGetIndexWith MutableArray# RealWorld a
contents Int
cur
            Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
            let next :: Int
next = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                -- XXX Change this to moveOff and remove curOff and nextOff
                move :: Int -> Int
move Int
n = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                curOff :: Int
curOff = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                nextOff :: Int
nextOff = Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
            case Step s b
pRes of
                ParserD.SDone Int
1 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
nextOff b
b
                ParserD.SDone Int
0 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
curOff b
b
                ParserD.SDone Int
n b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone (Int -> Int
move Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) b
b
                ParserD.SPartial Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.SPartial Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.SPartial Int
n s
pst1 ->
                    Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
move Int
n) Int -> s -> m (Step (Array a) m r)
onPartial s
pst1
                ParserD.SContinue Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.SContinue Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.SContinue Int
n s
pst1 ->
                    Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
move Int
n) Int -> s -> m (Step (Array a) m r)
onContinue s
pst1
                ParserD.SError String
err ->
                    Int -> String -> m (Step (Array a) m r)
onError Int
curOff String
err

    {-# NOINLINE parseContNothing #-}
    parseContNothing :: Int -> s -> m (Step (Array a) m r)
parseContNothing !Int
count !s
pst = do
        Final s b
r <- s -> m (Final s b)
extract s
pst
        case Final s b
r of
            ParserD.FDone Int
n b
b ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
n b
b) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Input (Array a)
forall a. Input a
None)
            ParserD.FContinue Int
n s
pst1 ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1)
                    (Step (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
n (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
pst1))
            ParserD.FError String
err ->
                -- XXX It is called only when there is no input arr. So using 0
                -- as the position is correct?
                ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count Input (Array a)
forall a. Input a
None

    {-# INLINE parseCont #-}
    parseCont :: Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont !Int
cnt !s
pst (Chunk Array a
arr) = Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
cnt Int
0 s
pst Array a
arr
    parseCont !Int
cnt !s
pst Input (Array a)
None = Int -> s -> m (Step (Array a) m r)
parseContNothing Int
cnt s
pst

-- | Convert a 'Parser' to 'ParserK' working on generic Array stream.
--
-- /Pre-release/
--
{-# INLINE_LATE toParserK #-}
toParserK :: Monad m => ParserD.Parser a m b -> ParserK (Array a) m b
toParserK :: forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> ParserK (Array a) m b
toParserK (ParserD.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Final s b)
extract) =
    (forall r.
 (ParseResult b -> Int -> StepParser (Array a) m r)
 -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array a) m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
ParserK.MkParser ((forall r.
  (ParseResult b -> Int -> StepParser (Array a) m r)
  -> Int -> Int -> StepParser (Array a) m r)
 -> ParserK (Array a) m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser (Array a) m r)
    -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array a) m b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Final s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Final s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCGWith s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Final s b)
extract