{-|
Module      : Z.Data.CBytes
Description : Null-ternimated byte string.
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides 'CBytes' with some useful instances \/ tools for retrieving, storing or processing
short byte sequences, such as file path, environment variables, etc.

-}

module Z.Data.CBytes
  (  -- * The CBytes type
    CBytes(CB)
  , rawPrimArray, fromPrimArray, fromMutablePrimArray
  , toBytes, toBytes', fromBytes, toText, toTextMaybe, fromText
  , toBuilder, toBuilder', buildCBytes
  , pack
  , unpack
  , null, length
  , empty, singleton, append, concat, intercalate, intercalateElem
  , fromCString, fromCStringN, fromStdString
  , withCBytesUnsafe, withCBytes, allocCBytesUnsafe, allocCBytes
  , withCBytesListUnsafe, withCBytesList
  , pokeMBACBytes, peekMBACBytes, indexBACBytes
  -- * re-export
  , CString
  ) where

import           Control.Applicative       ((<|>))
import           Control.DeepSeq
import           Control.Exception
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Data.Bits
import           Data.Foldable             (foldlM)
import           Data.Hashable             (Hashable (..))
import qualified Data.List                 as List
import           Data.Word
import           Foreign.C.String
import           GHC.Exts
import           GHC.Ptr
import           GHC.Stack
import           Prelude                   hiding (all, any, appendFile, break,
                                            concat, concatMap, drop, dropWhile,
                                            elem, filter, foldl, foldl1, foldr,
                                            foldr1, getContents, getLine, head,
                                            init, interact, last, length, lines,
                                            map, maximum, minimum, notElem,
                                            null, putStr, putStrLn, readFile,
                                            replicate, reverse, scanl, scanl1,
                                            scanr, scanr1, span, splitAt, tail,
                                            take, takeWhile, unlines, unzip,
                                            writeFile, zip, zipWith)
import           System.IO.Unsafe          (unsafeDupablePerformIO)
import           Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..))
import           Text.Read                 (Read (..))
import qualified Z.Data.Builder            as B
import           Z.Data.JSON.Base          ((.!), (.:), (.=))
import qualified Z.Data.JSON.Base          as JSON
import qualified Z.Data.Text               as T
import qualified Z.Data.Text.Print         as T
import           Z.Data.Text.UTF8Codec     (decodeChar, encodeCharModifiedUTF8)
import qualified Z.Data.Text.UTF8Codec     as T
import qualified Z.Data.Vector.Base        as V
import           Z.Foreign                 hiding (fromStdString)

-- | A efficient wrapper for short immutable null-terminated byte sequences which can be
-- automatically freed by ghc garbage collector.
--
-- The main use case of this type is to ease the bridging of C FFI APIs, since most
-- of the unix APIs use null-terminated string. On windows you're encouraged to use a
-- compatibility layer like 'WideCharToMultiByte/MultiByteToWideChar' and keep the same
-- interface, e.g. libuv do this when deal with file paths.
--
-- 'CBytes' don't support O(1) slicing, it's not suitable to use it to store large byte
-- chunk, If you need advance editing, convert 'CBytes' to\/from 'V.Bytes' with 'CB' pattern or
-- 'toBytes' \/ 'fromBytes', then use vector combinators.
--
-- When textual represatation is needed e.g. converting to 'String', 'T.Text', 'Show' instance, etc.,
-- we assume 'CBytes' using UTF-8 encodings, 'CBytes' can be used with @OverloadedString@,
-- literal encoding is UTF-8 with some modifications: @\\NUL@ is encoded to 'C0 80',
-- and @\\xD800@ ~ @\\xDFFF@ is encoded as a three bytes normal utf-8 codepoint.
--
-- Note most of the unix API is not unicode awared though, you may find a `scandir` call
-- return a filename which is not proper encoded in any unicode encoding at all.
-- But still, UTF-8 is recommanded to be used when text represatation is needed.
--
newtype CBytes = CBytes
    {
        -- | Convert to a @\\NUL@ terminated 'PrimArray',
        --
        -- There's an invariance that this array never contains extra @\\NUL@ except terminator.
        CBytes -> PrimArray Word8
rawPrimArray :: PrimArray Word8
    }

-- | Construct a 'CBytes' from arbitrary array, result will be trimmed down to first @\\NUL@ byte if there's any.
fromPrimArray :: PrimArray Word8 -> CBytes
{-# INLINABLE fromPrimArray #-}
fromPrimArray :: PrimArray Word8 -> CBytes
fromPrimArray PrimArray Word8
arr = forall a. (forall s. ST s a) -> a
runST (do
    let l :: Int
l = case forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
0 PrimArray Word8
arr of
            Just Int
i -> Int
i
            Maybe Int
_      -> forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr
    if Int
lforall a. Num a => a -> a -> a
+Int
1 forall a. Eq a => a -> a -> Bool
== forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr
    then forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
arr)
    else do
        MutablePrimArray s Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lforall a. Num a => a -> a -> a
+Int
1)
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
mpa Int
0 PrimArray Word8
arr Int
0 Int
l
        -- write \\NUL terminator
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
mpa Int
l Word8
0
        PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
mpa
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa))

-- | Construct a 'CBytes' from a 'MutablePrimArray'.
--
-- Result will be shrinked to first @\\NUL@ byte without copy. If there is no
-- @\\NUL@ found in the array, We will resize the origin MutablePrimArray, so,
-- to avoid undefined behaviour, the original MutablePrimArray shall not be
-- accessed anymore. Moreover, no reference to the old one should be kept in
-- order to allow garbage collection of the original MutablePrimArray in case
-- a new MutablePrimArray had to be allocated.
fromMutablePrimArray
    :: PrimMonad m
    => MutablePrimArray (PrimState m) Word8
    -> m CBytes
{-# INLINABLE fromMutablePrimArray #-}
fromMutablePrimArray :: forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> m CBytes
fromMutablePrimArray MutablePrimArray (PrimState m) Word8
marr = do
    let l :: Int
l = forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray (PrimState m) Word8
marr
    PrimArray Word8
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState m) Word8
marr
    MutablePrimArray (PrimState m) Word8
marr' <- case forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
0 PrimArray Word8
arr of
        Just Int
i -> forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return MutablePrimArray (PrimState m) Word8
marr
        Maybe Int
_ -> do
            MutablePrimArray (PrimState m) Word8
marr' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
l forall a. Num a => a -> a -> a
+ Int
1)
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr' Int
l Word8
0
            forall (m :: * -> *) a. Monad m => a -> m a
return MutablePrimArray (PrimState m) Word8
marr'
    !PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState m) Word8
marr'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa

-- | Use this pattern to match or construct 'CBytes', result will be trimmed down to first @\\NUL@ byte if there's any.
pattern CB :: V.Bytes -> CBytes
{-# COMPLETE CB #-}
pattern $bCB :: Bytes -> CBytes
$mCB :: forall {r}. CBytes -> (Bytes -> r) -> ((# #) -> r) -> r
CB bs <- (toBytes -> bs) where
    CB Bytes
bs = Bytes -> CBytes
fromBytes Bytes
bs

instance Show CBytes where
    showsPrec :: Int -> CBytes -> ShowS
showsPrec Int
p CBytes
t = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (CBytes -> String
unpack CBytes
t)

instance Read CBytes where
    readPrec :: ReadPrec CBytes
readPrec = String -> CBytes
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec

instance NFData CBytes where
    {-# INLINE rnf #-}
    rnf :: CBytes -> ()
rnf (CBytes PrimArray Word8
_) = ()

instance Eq CBytes where
    {-# INLINE (==) #-}
    -- \\NUL does not affect equality
    CBytes PrimArray Word8
ba == :: CBytes -> CBytes -> Bool
== CBytes PrimArray Word8
bb = PrimArray Word8
ba forall a. Eq a => a -> a -> Bool
== PrimArray Word8
bb

instance Ord CBytes where
    {-# INLINE compare #-}
    -- \\NUL does not affect ordering
    CBytes PrimArray Word8
ba compare :: CBytes -> CBytes -> Ordering
`compare` CBytes PrimArray Word8
bb = PrimArray Word8
ba forall a. Ord a => a -> a -> Ordering
`compare` PrimArray Word8
bb

instance Semigroup CBytes where
    <> :: CBytes -> CBytes -> CBytes
(<>) = CBytes -> CBytes -> CBytes
append

instance Monoid CBytes where
    {-# INLINE mempty #-}
    mempty :: CBytes
mempty  = CBytes
empty
    {-# INLINE mappend #-}
    mappend :: CBytes -> CBytes -> CBytes
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mconcat #-}
    mconcat :: [CBytes] -> CBytes
mconcat = [CBytes] -> CBytes
concat

instance Hashable CBytes where
    hashWithSalt :: Int -> CBytes -> Int
hashWithSalt Int
salt (CBytes pa :: PrimArray Word8
pa@(PrimArray ByteArray#
ba#)) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
        ByteArray# -> Int -> Int -> Int -> IO Int
V.c_fnv_hash_ba ByteArray#
ba# Int
0 (forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa forall a. Num a => a -> a -> a
- Int
1) Int
salt

instance Arbitrary CBytes where
    arbitrary :: Gen CBytes
arbitrary = String -> CBytes
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    shrink :: CBytes -> [CBytes]
shrink CBytes
a = String -> CBytes
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink (CBytes -> String
unpack CBytes
a)

instance CoArbitrary CBytes where
    coarbitrary :: forall b. CBytes -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> String
unpack

-- | Poke 'CBytes' until a \\NUL terminator(or to the end of the array if there's none).
peekMBACBytes :: MBA# Word8 -> Int -> IO CBytes
{-# INLINE peekMBACBytes #-}
peekMBACBytes :: MBA# Word8 -> Int -> IO CBytes
peekMBACBytes MBA# Word8
mba# Int
i = do
    Int
b <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
getSizeofMutableByteArray (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MBA# Word8
mba#)
    let rest :: Int
rest = Int
bforall a. Num a => a -> a -> a
-Int
i
    Int
l <- MBA# Word8 -> Int -> Word8 -> Int -> IO Int
c_memchr MBA# Word8
mba# Int
i Word8
0 Int
rest
    let l' :: Int
l' = if Int
l forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
rest else Int
l
    MutablePrimArray RealWorld Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'forall a. Num a => a -> a -> a
+Int
1)
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
mpa Int
0 (forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MBA# Word8
mba#) Int
i Int
l'
    -- write \\NUL terminator
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
mpa Int
l' Word8
0
    PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mpa
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa)

-- | Poke 'CBytes' with \\NUL terminator.
pokeMBACBytes :: MBA# Word8 -> Int -> CBytes -> IO ()
{-# INLINE pokeMBACBytes #-}
pokeMBACBytes :: MBA# Word8 -> Int -> CBytes -> IO ()
pokeMBACBytes MBA# Word8
mba# Int
i (CBytes PrimArray Word8
pa) = do
        let l :: Int
l = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray (forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MBA# Word8
mba# :: MutablePrimArray RealWorld Word8) Int
i PrimArray Word8
pa Int
0 Int
l

-- | Index a 'CBytes' until a \\NUL terminator(or to the end of the array if there's none).
indexBACBytes :: BA# Word8 -> Int -> CBytes
{-# INLINE indexBACBytes #-}
indexBACBytes :: ByteArray# -> Int -> CBytes
indexBACBytes ByteArray#
ba# Int
i = forall a. (forall s. ST s a) -> a
runST (do
    let b :: Int
b = ByteArray -> Int
sizeofByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
        rest :: Int
rest = Int
bforall a. Num a => a -> a -> a
-Int
i
        l :: Int
l = ByteArray# -> Int -> Word8 -> Int -> Int
V.c_memchr ByteArray#
ba# Int
i Word8
0 Int
rest
        l' :: Int
l' = if Int
l forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
rest else Int
l
    MutablePrimArray s Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'forall a. Num a => a -> a -> a
+Int
1)
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
mpa Int
0 (forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba#) Int
i Int
l'
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
mpa Int
l' Word8
0
    PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
mpa
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa))

-- | This instance provide UTF8 guarantee, illegal codepoints will be written as 'T.replacementChar's.
--
-- Escaping rule is same with 'String'.
instance T.Print CBytes where
    {-# INLINE toUTF8BuilderP #-}
    toUTF8BuilderP :: Int -> CBytes -> Builder ()
toUTF8BuilderP Int
_ = String -> Builder ()
T.stringUTF8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> String
unpack

-- | JSON instances check if 'CBytes' is properly UTF8 encoded,
-- if it is, decode/encode it as 'T.Text', otherwise as an object with a @__base64@ field.
--
-- @
-- > encodeText ("hello" :: CBytes)
-- "\"hello\""
-- > encodeText ("hello\\NUL" :: CBytes)     -- @\\NUL@ is encoded as C0 80, which is illegal UTF8
-- "{\"__base64\":\"aGVsbG/AgA==\"}"
-- @
instance JSON.JSON CBytes where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter CBytes
fromValue Value
v = forall a. Text -> (Text -> Converter a) -> Value -> Converter a
JSON.withText Text
"Z.Data.CBytes" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CBytes
fromText) Value
v
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
JSON.withFlatMapR Text
"Z.Data.CBytes" (\ FlatMap Text Value
o -> Bytes -> CBytes
fromBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FlatMap Text Value
o forall a. JSON a => FlatMap Text Value -> Text -> Converter a
.: Text
"__base64") Value
v
    {-# INLINE toValue #-}
    toValue :: CBytes -> Value
toValue CBytes
cbytes = case CBytes -> Maybe Text
toTextMaybe CBytes
cbytes of
        Just Text
t  -> forall a. JSON a => a -> Value
JSON.toValue Text
t
        Maybe Text
Nothing -> [(Text, Value)] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$ [ Text
"__base64" forall v. JSON v => Text -> v -> (Text, Value)
.= CBytes -> Bytes
toBytes CBytes
cbytes ]
    {-# INLINE encodeJSON #-}
    encodeJSON :: CBytes -> Builder ()
encodeJSON CBytes
cbytes = case CBytes -> Maybe Text
toTextMaybe CBytes
cbytes of
        Just Text
t  -> forall a. JSON a => a -> Builder ()
JSON.encodeJSON Text
t
        Maybe Text
Nothing -> KVItem -> Builder ()
JSON.object' forall a b. (a -> b) -> a -> b
$ Text
"__base64" forall v. JSON v => Text -> v -> KVItem
.! CBytes -> Bytes
toBytes CBytes
cbytes

-- | Concatenate two 'CBytes'.
append :: CBytes -> CBytes -> CBytes
{-# INLINE append #-}
append :: CBytes -> CBytes -> CBytes
append strA :: CBytes
strA@(CBytes PrimArray Word8
pa) strB :: CBytes
strB@(CBytes PrimArray Word8
pb)
    | Int
lenA forall a. Eq a => a -> a -> Bool
== Int
0 = CBytes
strB
    | Int
lenB forall a. Eq a => a -> a -> Bool
== Int
0 = CBytes
strA
    | Bool
otherwise = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray RealWorld Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lenAforall a. Num a => a -> a -> a
+Int
lenBforall a. Num a => a -> a -> a
+Int
1)
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
mpa Int
0    PrimArray Word8
pa Int
0 Int
lenA
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
mpa Int
lenA PrimArray Word8
pb Int
0 Int
lenB
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
mpa (Int
lenA forall a. Num a => a -> a -> a
+ Int
lenB) Word8
0     -- the \\NUL terminator
        PrimArray Word8
pa' <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mpa
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa')
  where
    lenA :: Int
lenA = CBytes -> Int
length CBytes
strA
    lenB :: Int
lenB = CBytes -> Int
length CBytes
strB

-- | Empty 'CBytes'
empty :: CBytes
{-# NOINLINE empty #-}
empty :: CBytes
empty = PrimArray Word8 -> CBytes
CBytes (forall (v :: * -> *) a. Vec v a => a -> v a
V.singleton Word8
0)

-- | Singleton 'CBytes'.
singleton :: Word8 -> CBytes
{-# INLINE singleton #-}
singleton :: Word8 -> CBytes
singleton Word8
w = forall a. (forall s. ST s a) -> a
runST (do
    MutablePrimArray s Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
buf Int
0 Word8
w
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
buf Int
1 Word8
0
    PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
buf
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa))

-- | /O(n)/ Concatenate a list of 'CBytes'.
--
concat :: [CBytes] -> CBytes
{-# INLINABLE concat #-}
concat :: [CBytes] -> CBytes
concat [CBytes]
bss = case Int -> Int -> [CBytes] -> (Int, Int)
pre Int
0 Int
0 [CBytes]
bss of
    (Int
0, Int
_) -> CBytes
empty
    (Int
1, Int
_) -> let Just CBytes
b = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Bool
null) [CBytes]
bss in CBytes
b -- there must be a not empty CBytes
    (Int
_, Int
l) -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lforall a. Num a => a -> a -> a
+Int
1)
        forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bss Int
0 MutablePrimArray s Word8
buf
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
buf Int
l Word8
0 -- the \\NUL terminator
        PrimArray Word8 -> CBytes
CBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
buf
  where
    -- pre scan to decide if we really need to copy and calculate total length
    -- we don't accumulate another result list, since it's rare to got empty
    pre :: Int -> Int -> [CBytes] -> (Int, Int)
    pre :: Int -> Int -> [CBytes] -> (Int, Int)
pre !Int
nacc !Int
lacc [] = (Int
nacc, Int
lacc)
    pre !Int
nacc !Int
lacc (CBytes
b:[CBytes]
bs)
        | Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> Int -> [CBytes] -> (Int, Int)
pre Int
nacc Int
lacc [CBytes]
bs
        | Bool
otherwise     = Int -> Int -> [CBytes] -> (Int, Int)
pre (Int
naccforall a. Num a => a -> a -> a
+Int
1) (Int
l forall a. Num a => a -> a -> a
+ Int
lacc) [CBytes]
bs
      where !l :: Int
l = CBytes -> Int
length CBytes
b

    copy :: [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
    copy :: forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [] !Int
_ !MutablePrimArray s Word8
_       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    copy (b :: CBytes
b@(CBytes PrimArray Word8
ba):[CBytes]
bs) !Int
i !MutablePrimArray s Word8
mba = do
        let l :: Int
l = CBytes -> Int
length CBytes
b
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Eq a => a -> a -> Bool
/= Int
0) (forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
mba Int
i PrimArray Word8
ba Int
0 Int
l)
        forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bs (Int
iforall a. Num a => a -> a -> a
+Int
l) MutablePrimArray s Word8
mba

-- | /O(n)/ The 'intercalate' function takes a 'CBytes' and a list of
-- 'CBytes' s and concatenates the list after interspersing the first
-- argument between each element of the list.
--
-- Note: 'intercalate' will force the entire 'CBytes' list.
--
intercalate :: CBytes -> [CBytes] -> CBytes
{-# INLINE intercalate #-}
intercalate :: CBytes -> [CBytes] -> CBytes
intercalate CBytes
s = [CBytes] -> CBytes
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
List.intersperse CBytes
s

-- | /O(n)/ An efficient way to join 'CByte' s with a byte.
--
-- Intercalate bytes list with @\\NUL@ will effectively leave the first bytes in the list.
intercalateElem :: Word8 -> [CBytes] -> CBytes
{-# INLINABLE intercalateElem #-}
intercalateElem :: Word8 -> [CBytes] -> CBytes
intercalateElem Word8
0 [] = CBytes
empty
intercalateElem Word8
0 (CBytes
bs:[CBytes]
_) = CBytes
bs
intercalateElem Word8
w8 [CBytes]
bss = case [CBytes] -> Int -> Int
len [CBytes]
bss Int
0 of
    Int
0 -> CBytes
empty
    Int
l -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lforall a. Num a => a -> a -> a
+Int
1)
        forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bss Int
0 MutablePrimArray s Word8
buf
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
buf Int
l Word8
0 -- the \\NUL terminator
        PrimArray Word8 -> CBytes
CBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
buf
  where
    len :: [CBytes] -> Int -> Int
len []     !Int
acc = Int
acc
    len [CBytes
b]    !Int
acc = CBytes -> Int
length CBytes
b forall a. Num a => a -> a -> a
+ Int
acc
    len (CBytes
b:[CBytes]
bs) !Int
acc = [CBytes] -> Int -> Int
len [CBytes]
bs (Int
acc forall a. Num a => a -> a -> a
+ CBytes -> Int
length CBytes
b forall a. Num a => a -> a -> a
+ Int
1)
    copy :: [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
    -- bss must not be empty, which is checked by len above
    copy :: forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy (b :: CBytes
b@(CBytes PrimArray Word8
ba):[CBytes]
bs) !Int
i !MutablePrimArray s Word8
mba = do
        let l :: Int
l = CBytes -> Int
length CBytes
b
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Eq a => a -> a -> Bool
/= Int
0) (forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
mba Int
i PrimArray Word8
ba Int
0 Int
l)
        case [CBytes]
bs of
            [] -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- last one
            [CBytes]
_  -> do
                let i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
l
                forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
mba Int
i' Word8
w8
                forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bs (Int
i'forall a. Num a => a -> a -> a
+Int
1) MutablePrimArray s Word8
mba
    copy [CBytes]
_ Int
_ MutablePrimArray s Word8
_ = forall a. HasCallStack => String -> a
error String
"Z.Data.CBytes.intercalateElem: impossible"

instance IsString CBytes where
    {-# INLINE fromString #-}
    fromString :: String -> CBytes
fromString = String -> CBytes
pack

{-# RULES
    "CBytes pack/unpackCString#" forall addr# .
        pack (unpackCString# addr#) = packAddr addr#
 #-}
{-# RULES
    "CBytes pack/unpackCStringUtf8#" forall addr# .
        pack (unpackCStringUtf8# addr#) = packAddr addr#
 #-}

packAddr :: Addr# -> CBytes
{-# INLINE packAddr #-}
packAddr :: Addr# -> CBytes
packAddr Addr#
addr0# = Addr# -> CBytes
go Addr#
addr0#
  where
    len :: Int
len = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
V.c_strlen Addr#
addr0#) forall a. Num a => a -> a -> a
+ Int
1
    go :: Addr# -> CBytes
go Addr#
addr# = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray s Word8
marr Int
0 (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
        PrimArray Word8
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
marr
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
arr)

-- | Pack a 'String' into 'CBytes'.
--
-- @\\NUL@ is encoded as two bytes @C0 80@ , @\\xD800@ ~ @\\xDFFF@ is encoded as a three bytes normal UTF-8 codepoint.
pack :: String -> CBytes
{-# INLINE CONLIKE [1] pack #-}
pack :: String -> CBytes
pack String
s = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s Word8
mba <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
V.defaultInitSize
    (SP2 Int
i MutablePrimArray s Word8
mba') <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM forall s. SP2 s -> Char -> ST s (SP2 s)
go (forall s. Int -> MutablePrimArray s Word8 -> SP2 s
SP2 Int
0 MutablePrimArray s Word8
mba) String
s
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
mba' Int
i Word8
0     -- the \\NUL terminator
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray s Word8
mba' (Int
iforall a. Num a => a -> a -> a
+Int
1)
    PrimArray Word8
ba <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
mba'
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
ba)
  where
    -- It's critical that this function get specialized and unboxed
    -- Keep an eye on its core!
    go :: SP2 s -> Char -> ST s (SP2 s)
    go :: forall s. SP2 s -> Char -> ST s (SP2 s)
go (SP2 Int
i MutablePrimArray s Word8
mba) !Char
c     = do
        Int
siz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Word8
mba
        if Int
i forall a. Ord a => a -> a -> Bool
< Int
siz forall a. Num a => a -> a -> a
- Int
4  -- we need at least 4 bytes for safety due to extra '\0' byte
        then do
            Int
i' <- forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeCharModifiedUTF8 MutablePrimArray s Word8
mba Int
i Char
c
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> MutablePrimArray s Word8 -> SP2 s
SP2 Int
i' MutablePrimArray s Word8
mba)
        else do
            let !siz' :: Int
siz' = Int
siz forall a. Bits a => a -> Int -> a
`shiftL` Int
1
            !MutablePrimArray s Word8
mba' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Word8
mba Int
siz'
            Int
i' <- forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeCharModifiedUTF8 MutablePrimArray s Word8
mba' Int
i Char
c
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> MutablePrimArray s Word8 -> SP2 s
SP2 Int
i' MutablePrimArray s Word8
mba')


data SP2 s = SP2 {-# UNPACK #-}!Int {-# UNPACK #-}!(MutablePrimArray s Word8)

-- | /O(n)/ Convert cbytes to a char list using UTF8 encoding assumption.
--
-- This function is much tolerant than 'toText', it simply decoding codepoints using UTF8 'decodeChar'
-- without checking errors such as overlong or invalid range.
--
-- Unpacking is done lazily. i.e. we will retain reference to the array until all element are consumed.
--
-- This function is a /good producer/ in the sense of build/foldr fusion.
unpack :: CBytes -> String
{-# INLINE [1] unpack #-}
unpack :: CBytes -> String
unpack (CBytes PrimArray Word8
arr) = Int -> String
go Int
0
  where
    !end :: Int
end = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> String
go !Int
idx
        | Int
idx forall a. Ord a => a -> a -> Bool
>= Int
end = []
        | Int
idx forall a. Num a => a -> a -> a
+ PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
idx forall a. Ord a => a -> a -> Bool
> Int
end = [Char
T.replacementChar]
        | Bool
otherwise = let (# Char
c, Int
i #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr Int
idx in Char
c forall a. a -> [a] -> [a]
: Int -> String
go (Int
idx forall a. Num a => a -> a -> a
+ Int
i)

unpackFB :: CBytes -> (Char -> a -> a) -> a -> a
{-# INLINE [0] unpackFB #-}
unpackFB :: forall a. CBytes -> (Char -> a -> a) -> a -> a
unpackFB (CBytes PrimArray Word8
arr) Char -> a -> a
k a
z = Int -> a
go Int
0
  where
    !end :: Int
end = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a
go !Int
idx
        | Int
idx forall a. Ord a => a -> a -> Bool
>= Int
end = a
z
        | Int
idx forall a. Num a => a -> a -> a
+ PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
idx forall a. Ord a => a -> a -> Bool
> Int
end = Char
T.replacementChar Char -> a -> a
`k` a
z
        | Bool
otherwise = let (# Char
c, Int
i #) = PrimArray Word8 -> Int -> (# Char, Int #)
decodeChar PrimArray Word8
arr Int
idx in Char
c Char -> a -> a
`k` Int -> a
go (Int
idx forall a. Num a => a -> a -> a
+ Int
i)

{-# RULES
"unpack" [~1] forall t . unpack t = build (\ k z -> unpackFB t k z)
"unpackFB" [1] forall t . unpackFB t (:) [] = unpack t
 #-}

--------------------------------------------------------------------------------

-- | Return 'True' if 'CBytes' is empty.
--
null :: CBytes -> Bool
{-# INLINE null #-}
null :: CBytes -> Bool
null (CBytes PrimArray Word8
pa) = forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
pa Int
0 forall a. Eq a => a -> a -> Bool
== Word8
0

-- | /O(1)/, Return the BTYE length of 'CBytes' without NULL terminator.
--
length :: CBytes -> Int
{-# INLINE length #-}
length :: CBytes -> Int
length (CBytes PrimArray Word8
pa) = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa forall a. Num a => a -> a -> a
- Int
1

-- | /O(1)/, convert to 'V.Bytes', which can be processed by vector combinators.
toBytes :: CBytes -> V.Bytes
{-# INLINE toBytes #-}
toBytes :: CBytes -> Bytes
toBytes (CBytes PrimArray Word8
arr) = forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 (forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr forall a. Num a => a -> a -> a
- Int
1)

-- | /O(1)/, convert to 'V.Bytes' with its NULL terminator.
toBytes' :: CBytes -> V.Bytes
{-# INLINE toBytes' #-}
toBytes' :: CBytes -> Bytes
toBytes' (CBytes PrimArray Word8
arr) = forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 (forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr)

-- | /O(n)/, convert from 'V.Bytes'
--
-- Result will be trimmed down to first @\\NUL@ byte if there's any.
fromBytes :: V.Bytes -> CBytes
{-# INLINABLE fromBytes #-}
fromBytes :: Bytes -> CBytes
fromBytes v :: Bytes
v@(V.PrimVector PrimArray Word8
arr Int
s Int
l)
        -- already a \\NUL terminated bytes
    | Int
s forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr forall a. Eq a => a -> a -> Bool
== (Int
lforall a. Num a => a -> a -> a
+Int
1) Bool -> Bool -> Bool
&& forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
arr Int
l forall a. Eq a => a -> a -> Bool
== Word8
0 =
        PrimArray Word8 -> CBytes
CBytes PrimArray Word8
arr
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST (do
        let l' :: Int
l' = case forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
0 Bytes
v of
                Just Int
i -> Int
i
                Maybe Int
_      -> Int
l
        MutablePrimArray s Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'forall a. Num a => a -> a -> a
+Int
1)
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
mpa Int
0 PrimArray Word8
arr Int
s Int
l'
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
mpa Int
l' Word8
0      -- the \\NUL terminator
        PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
mpa
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa))

-- | /O(n)/, convert to 'T.Text' using UTF8 encoding assumption.
--
-- Throw 'T.InvalidUTF8Exception' in case of invalid codepoint.
toText :: HasCallStack => CBytes -> T.Text
{-# INLINE toText #-}
toText :: HasCallStack => CBytes -> Text
toText = HasCallStack => Bytes -> Text
T.validate forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Bytes
toBytes

-- | /O(n)/, convert to 'T.Text' using UTF8 encoding assumption.
--
-- Return 'Nothing' in case of invalid codepoint.
toTextMaybe :: CBytes -> Maybe T.Text
{-# INLINE toTextMaybe #-}
toTextMaybe :: CBytes -> Maybe Text
toTextMaybe = Bytes -> Maybe Text
T.validateMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Bytes
toBytes

-- | /O(n)/, convert from 'T.Text',
--
-- Result will be trimmed down to first @\\NUL@ byte if there's any.
fromText :: T.Text -> CBytes
{-# INLINE fromText #-}
fromText :: Text -> CBytes
fromText = Bytes -> CBytes
fromBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
T.getUTF8Bytes

-- | Write 'CBytes' \'s byte sequence to buffer.
--
-- This function is different from 'T.Print' instance in that it directly write byte sequence without
-- checking if it's UTF8 encoded.
toBuilder :: CBytes -> B.Builder ()
{-# INLINE toBuilder #-}
toBuilder :: CBytes -> Builder ()
toBuilder = Bytes -> Builder ()
B.bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Bytes
toBytes

-- | Write 'CBytes' \'s byte sequence to buffer, with its NULL terminator.
--
toBuilder' :: CBytes -> B.Builder ()
{-# INLINE toBuilder' #-}
toBuilder' :: CBytes -> Builder ()
toBuilder' = Bytes -> Builder ()
B.bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Bytes
toBytes'

-- | Build a 'CBytes' with builder, will automatically be trimmed down to first @\\NUL@ byte if there's any,
-- or append with one if there's none.
buildCBytes :: B.Builder a -> CBytes
{-# INLINE buildCBytes #-}
buildCBytes :: forall a. Builder a -> CBytes
buildCBytes Builder a
b = Bytes -> CBytes
fromBytes (forall a. Builder a -> Bytes
B.build (Builder a
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
B.word8 Word8
0))

--------------------------------------------------------------------------------

-- | Copy a 'CString' type into a 'CBytes', return 'empty' if the pointer is NULL.
--
--  After copying you're free to free the 'CString' 's memory.
fromCString :: CString -> IO CBytes
{-# INLINABLE fromCString #-}
fromCString :: CString -> IO CBytes
fromCString CString
cstring = do
    if CString
cstring forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
empty
    else do
        Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO CSize
c_strlen_ptr CString
cstring
        let len' :: Int
len' = Int
len forall a. Num a => a -> a -> a
+ Int
1
        MutablePrimArray RealWorld Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len'
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
mpa Int
0 (forall a b. Ptr a -> Ptr b
castPtr CString
cstring) Int
len'
        PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mpa
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa)

-- | Same with 'fromCString', but only take at most N bytes.
--
-- Result will be trimmed down to first @\\NUL@ byte if there's any.
fromCStringN :: CString -> Int -> IO CBytes
{-# INLINABLE fromCStringN #-}
fromCStringN :: CString -> Int -> IO CBytes
fromCStringN CString
cstring Int
len0 = do
    if CString
cstring forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
len0 forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
empty
    else do
        Int
len1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO CSize
c_strlen_ptr CString
cstring
        let len :: Int
len = forall a. Ord a => a -> a -> a
min Int
len0 Int
len1
        MutablePrimArray RealWorld Word8
mpa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lenforall a. Num a => a -> a -> a
+Int
1)
        forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
mpa Int
0 (forall a b. Ptr a -> Ptr b
castPtr CString
cstring) Int
len
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
mpa Int
len Word8
0     -- the \\NUL terminator
        PrimArray Word8
pa <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mpa
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
pa)

-- | Pass 'CBytes' to foreign function as a @const char*@.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withCBytesUnsafe :: CBytes -> (BA# Word8 -> IO a) -> IO a
{-# INLINABLE withCBytesUnsafe #-}
withCBytesUnsafe :: forall a. CBytes -> (ByteArray# -> IO a) -> IO a
withCBytesUnsafe (CBytes PrimArray Word8
pa) ByteArray# -> IO a
f = forall a b.
Prim a =>
PrimArray a -> (ByteArray# -> Int -> IO b) -> IO b
withPrimArrayUnsafe PrimArray Word8
pa (\ ByteArray#
p Int
_ -> ByteArray# -> IO a
f ByteArray#
p)

-- | Pass 'CBytes' list to foreign function as a @StgArrBytes**@.
--
-- Enable 'UnliftedFFITypes' extension in your haskell code, use @StgArrBytes**@(>=8.10)
-- or @StgMutArrPtrs*@(<8.10) pointer type and @HsInt@
-- to marshall @BAArray#@ and @Int@ arguments on C side, check the example with 'BAArray#'.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withCBytesListUnsafe :: [CBytes] -> (BAArray# Word8 -> Int -> IO a) -> IO a
{-# INLINABLE withCBytesListUnsafe #-}
withCBytesListUnsafe :: forall a. [CBytes] -> (BAArray# Word8 -> Int -> IO a) -> IO a
withCBytesListUnsafe [CBytes]
pas = forall a b.
[PrimArray a] -> (BAArray# Word8 -> Int -> IO b) -> IO b
withPrimArrayListUnsafe (forall a b. (a -> b) -> [a] -> [b]
List.map CBytes -> PrimArray Word8
rawPrimArray [CBytes]
pas)

-- | Pass 'CBytes' to foreign function as a @const char*@.
--
-- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.
withCBytes :: CBytes -> (Ptr Word8 -> IO a) -> IO a
{-# INLINABLE withCBytes #-}
withCBytes :: forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes (CBytes PrimArray Word8
pa) Ptr Word8 -> IO a
f = forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArraySafe PrimArray Word8
pa (\ Ptr Word8
p Int
_ -> Ptr Word8 -> IO a
f Ptr Word8
p)

-- | Pass 'CBytes' list to foreign function as a @const char**@.
--
-- Check "Z.Foreign" module for more detail on how to marshall params in C side.
withCBytesList :: [CBytes] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
{-# INLINABLE withCBytesList #-}
withCBytesList :: forall a. [CBytes] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
withCBytesList [CBytes]
pas = forall a b.
Prim a =>
[PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayListSafe (forall a b. (a -> b) -> [a] -> [b]
List.map CBytes -> PrimArray Word8
rawPrimArray [CBytes]
pas)

-- | Create a 'CBytes' with IO action.
--
-- If (<=0) capacity is provided, a pointer pointing to @\\NUL@ is passed to initialize function
-- and 'empty' will be returned. This behavior is different from 'allocCBytes', which may cause
-- trouble for some FFI functions.
--
-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocCBytesUnsafe :: HasCallStack
                  => Int                   -- ^ capacity n(including the @\\NUL@ terminator)
                  -> (MBA# Word8 -> IO a)  -- ^ initialization function,
                  -> IO (CBytes, a)
{-# INLINABLE allocCBytesUnsafe #-}
allocCBytesUnsafe :: forall a.
HasCallStack =>
Int -> (MBA# Word8 -> IO a) -> IO (CBytes, a)
allocCBytesUnsafe Int
n MBA# Word8 -> IO a
fill | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a b. Prim a => a -> (MBA# Word8 -> IO b) -> IO (a, b)
withPrimUnsafe (Word8
0::Word8) MBA# Word8 -> IO a
fill forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                        \ (Word8
_, a
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes
empty, a
b)
                         | Bool
otherwise = do
    mba :: MutablePrimArray RealWorld Word8
mba@(MutablePrimArray MBA# Word8
mba#) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
n :: IO (MutablePrimArray RealWorld Word8)
    a
a <- MBA# Word8 -> IO a
fill MBA# Word8
mba#
    Int
l <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MBA# Word8 -> Int -> Word8 -> Int -> IO Int
c_memchr MBA# Word8
mba# Int
0 Word8
0 Int
n
    let l' :: Int
l' = if Int
l forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
nforall a. Num a => a -> a -> a
-Int
1 else Int
l
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
mba (Int
l'forall a. Num a => a -> a -> a
+Int
1)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
mba Int
l' Word8
0
    PrimArray Word8
bs <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mba
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
bs, a
a)


-- | Create a 'CBytes' with IO action.
--
-- If (<=0) capacity is provided, a 'nullPtr' is passed to initialize function and
-- 'empty' will be returned. Other than that, User have to make sure a @\\NUL@ ternimated
-- string will be written.
allocCBytes :: HasCallStack
            => Int                -- ^ capacity n(including the @\\NUL@ terminator)
            -> (CString -> IO a)  -- ^ initialization function,
            -> IO (CBytes, a)
{-# INLINABLE allocCBytes #-}
allocCBytes :: forall a.
HasCallStack =>
Int -> (CString -> IO a) -> IO (CBytes, a)
allocCBytes Int
n CString -> IO a
fill | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = CString -> IO a
fill forall a. Ptr a
nullPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes
empty, a
a)
                   | Bool
otherwise = do
    mba :: MutablePrimArray RealWorld Word8
mba@(MutablePrimArray MBA# Word8
mba#) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
n :: IO (MutablePrimArray RealWorld Word8)
    a
a <- forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
mba (CString -> IO a
fill forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
    Int
l <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MBA# Word8 -> Int -> Word8 -> Int -> IO Int
c_memchr MBA# Word8
mba# Int
0 Word8
0 Int
n
    let l' :: Int
l' = if Int
l forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
nforall a. Num a => a -> a -> a
-Int
1 else Int
l
    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
mba (Int
l'forall a. Num a => a -> a -> a
+Int
1)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
mba Int
l' Word8
0
    PrimArray Word8
bs <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mba
    forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
bs, a
a)

-- | Run FFI in bracket and marshall @std::string*@ result into 'CBytes',
-- memory pointed by @std::string*@ will be @delete@ ed.
fromStdString :: IO (Ptr StdString) -> IO CBytes
fromStdString :: IO (Ptr StdString) -> IO CBytes
fromStdString IO (Ptr StdString)
f = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr StdString)
f Ptr StdString -> IO ()
hs_delete_std_string
    (\ Ptr StdString
q -> do
        Int
siz <- Ptr StdString -> IO Int
hs_std_string_size Ptr StdString
q
        let !siz' :: Int
siz' = Int
siz forall a. Num a => a -> a -> a
+ Int
1
        (PrimArray Word8
bs,()
_) <- forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe Int
siz' (Ptr StdString -> Int -> MBA# Word8 -> IO ()
hs_copy_std_string Ptr StdString
q Int
siz')
        forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
bs))

--------------------------------------------------------------------------------

c_strlen_ptr :: CString -> IO CSize
{-# INLINE c_strlen_ptr #-}
c_strlen_ptr :: CString -> IO CSize
c_strlen_ptr (Ptr Addr#
a#) = Addr# -> IO CSize
V.c_strlen Addr#
a#

-- HsInt hs_memchr(uint8_t *a, HsInt aoff, uint8_t b, HsInt n);
foreign import ccall unsafe "hs_memchr"
    c_memchr :: MBA# Word8 -> Int -> Word8 -> Int -> IO Int