{-|
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.Primitive.PrimArray
import           Data.Word
import           Foreign.C.String
import           GHC.CString
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           Z.Data.Array
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
{-# INLINE fromPrimArray #-}
fromPrimArray :: PrimArray Word8 -> CBytes
fromPrimArray PrimArray Word8
arr = (forall s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST (do
    let l :: Int
l = case Word8 -> PrimArray Word8 -> Maybe Int
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
_      -> PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr
    if Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr
    then CBytes -> ST s CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> CBytes
CBytes PrimArray Word8
arr)
    else do
        MutablePrimArray s Word8
mpa <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
0 PrimArray Word8
arr Int
0 Int
l
        -- write \\NUL terminator
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
l Word8
0
        PrimArray Word8
pa <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa
        CBytes -> ST s CBytes
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
{-# INLINE fromMutablePrimArray #-}
fromMutablePrimArray :: MutablePrimArray (PrimState m) Word8 -> m CBytes
fromMutablePrimArray MutablePrimArray (PrimState m) Word8
marr = do
    let l :: Int
l = MutablePrimArray (PrimState m) Word8 -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray (PrimState m) Word8
marr
    PrimArray Word8
arr <- MutablePrimArray (PrimState m) Word8 -> m (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState m) Word8
marr
    MutablePrimArray (PrimState m) Word8
marr' <- case Word8 -> PrimArray Word8 -> Maybe Int
forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
0 PrimArray Word8
arr of
        Just Int
i -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) m ()
-> m (MutablePrimArray (PrimState m) Word8)
-> m (MutablePrimArray (PrimState m) Word8)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutablePrimArray (PrimState m) Word8
-> m (MutablePrimArray (PrimState m) Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return MutablePrimArray (PrimState m) Word8
marr
        Maybe Int
_ -> do
            MutablePrimArray (PrimState m) Word8
marr' <- MutablePrimArray (PrimState m) Word8
-> Int -> m (MutablePrimArray (PrimState m) Word8)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr' Int
l Word8
0
            MutablePrimArray (PrimState m) Word8
-> m (MutablePrimArray (PrimState m) Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return MutablePrimArray (PrimState m) Word8
marr'
    !PrimArray Word8
pa <- MutablePrimArray (PrimState m) Word8 -> m (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState m) Word8
marr'
    CBytes -> m CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes -> m CBytes) -> CBytes -> m CBytes
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) -> (Void# -> 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 = Int -> String -> ShowS
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 (String -> CBytes) -> ReadPrec String -> ReadPrec CBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String
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 PrimArray Word8 -> PrimArray Word8 -> Bool
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 PrimArray Word8 -> PrimArray Word8 -> Ordering
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 = CBytes -> CBytes -> CBytes
append
    {-# 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#)) = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
        ByteArray# -> Int -> Int -> Int -> IO Int
V.c_fnv_hash_ba ByteArray#
ba# Int
0 (PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
salt

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

instance CoArbitrary CBytes where
    coarbitrary :: CBytes -> Gen b -> Gen b
coarbitrary = String -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (String -> Gen b -> Gen b)
-> (CBytes -> String) -> CBytes -> Gen b -> Gen b
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 <- MutableByteArray (PrimState IO) -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
getSizeofMutableByteArray (MBA# Word8 -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MBA# Word8
mba#)
    let rest :: Int
rest = Int
bInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
rest else Int
l
    MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    MutablePrimArray (PrimState IO) Word8
-> Int
-> MutablePrimArray (PrimState IO) Word8
-> Int
-> Int
-> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
0 (MBA# Word8 -> MutablePrimArray RealWorld Word8
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MBA# Word8
mba#) Int
i Int
l'
    -- write \\NUL terminator
    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
l' Word8
0
    PrimArray Word8
pa <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa
    CBytes -> IO CBytes
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 = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa
        MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray (MBA# Word8 -> MutablePrimArray RealWorld Word8
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MBA# Word8
mba# :: MutablePrimArray RealWorld Word8) Int
i PrimArray Word8
pa Int
0 Int
l

indexBACBytes :: BA# Word8 -> Int -> CBytes
{-# INLINE indexBACBytes #-}
indexBACBytes :: ByteArray# -> Int -> CBytes
indexBACBytes ByteArray#
ba# Int
i = (forall s. ST s CBytes) -> CBytes
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
bInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
rest else Int
l
    MutablePrimArray s Word8
mpa <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
0 (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba#) Int
i Int
l'
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
l' Word8
0
    PrimArray Word8
pa <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa
    CBytes -> ST s CBytes
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 (String -> Builder ())
-> (CBytes -> String) -> CBytes -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show ShowS -> (CBytes -> String) -> CBytes -> String
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 = Text -> (Text -> Converter CBytes) -> Value -> Converter CBytes
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
JSON.withText Text
"Z.Data.CBytes" (CBytes -> Converter CBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CBytes -> Converter CBytes)
-> (Text -> CBytes) -> Text -> Converter CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CBytes
fromText) Value
v
                Converter CBytes -> Converter CBytes -> Converter CBytes
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
-> (FlatMap Text Value -> Converter CBytes)
-> Value
-> Converter CBytes
forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
JSON.withFlatMapR Text
"Z.Data.CBytes" (\ FlatMap Text Value
o -> Bytes -> CBytes
fromBytes (Bytes -> CBytes) -> Converter Bytes -> Converter CBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FlatMap Text Value
o FlatMap Text Value -> Text -> Converter Bytes
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  -> Text -> Value
forall a. JSON a => a -> Value
JSON.toValue Text
t
        Maybe Text
Nothing -> [(Text, Value)] -> Value
JSON.object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [ Text
"base64" Text -> Bytes -> (Text, Value)
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  -> Text -> Builder ()
forall a. JSON a => a -> Builder ()
JSON.encodeJSON Text
t
        Maybe Text
Nothing -> KVItem -> Builder ()
JSON.object' (KVItem -> Builder ()) -> KVItem -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"base64" Text -> Bytes -> KVItem
forall v. JSON v => Text -> v -> KVItem
.! CBytes -> Bytes
toBytes CBytes
cbytes

-- | Concatenate two 'CBytes'.
append :: CBytes -> CBytes -> CBytes
{-# INLINABLE append #-}
append :: CBytes -> CBytes -> CBytes
append strA :: CBytes
strA@(CBytes PrimArray Word8
pa) strB :: CBytes
strB@(CBytes PrimArray Word8
pb)
    | Int
lenA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = CBytes
strB
    | Int
lenB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = CBytes
strA
    | Bool
otherwise = IO CBytes -> CBytes
forall a. IO a -> a
unsafeDupablePerformIO (IO CBytes -> CBytes) -> IO CBytes -> CBytes
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lenAInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenBInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
0    PrimArray Word8
pa Int
0 Int
lenA
        MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
lenA PrimArray Word8
pb Int
0 Int
lenB
        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa (Int
lenA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenB) Word8
0     -- the \\NUL terminator
        PrimArray Word8
pa' <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa
        CBytes -> IO CBytes
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 (Word8 -> PrimArray Word8
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 s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST (do
    MutablePrimArray s Word8
buf <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
2
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf Int
0 Word8
w
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf Int
1 Word8
0
    PrimArray Word8
pa <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf
    CBytes -> ST s CBytes
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 = (CBytes -> Bool) -> [CBytes] -> Maybe CBytes
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not (Bool -> Bool) -> (CBytes -> Bool) -> CBytes -> Bool
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 s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s CBytes) -> CBytes)
-> (forall s. ST s CBytes) -> CBytes
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
buf <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bss Int
0 MutablePrimArray s Word8
buf
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf Int
l Word8
0 -- the \\NUL terminator
        PrimArray Word8 -> CBytes
CBytes (PrimArray Word8 -> CBytes)
-> ST s (PrimArray Word8) -> ST s CBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST 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 Int -> Int -> Bool
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
naccInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
l Int -> Int -> Int
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 :: [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [] !Int
_ !MutablePrimArray s Word8
_       = () -> ST s ()
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
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba Int
i PrimArray Word8
ba Int
0 Int
l)
        [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bs (Int
iInt -> Int -> Int
forall 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 ([CBytes] -> CBytes)
-> ([CBytes] -> [CBytes]) -> [CBytes] -> CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> [CBytes] -> [CBytes]
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 s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s CBytes) -> CBytes)
-> (forall s. ST s CBytes) -> CBytes
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
buf <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bss Int
0 MutablePrimArray s Word8
buf
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf Int
l Word8
0 -- the \\NUL terminator
        PrimArray Word8 -> CBytes
CBytes (PrimArray Word8 -> CBytes)
-> ST s (PrimArray Word8) -> ST s CBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
buf
  where
    len :: [CBytes] -> Int -> Int
len []     !Int
acc = Int
acc
    len [CBytes
b]    !Int
acc = CBytes -> Int
length CBytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc
    len (CBytes
b:[CBytes]
bs) !Int
acc = [CBytes] -> Int -> Int
len [CBytes]
bs (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CBytes -> Int
length CBytes
b Int -> Int -> Int
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 :: [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
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba Int
i PrimArray Word8
ba Int
0 Int
l)
        case [CBytes]
bs of
            [] -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- last one
            [CBytes]
_  -> do
                let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
                MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba Int
i' Word8
w8
                [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
forall s. [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s ()
copy [CBytes]
bs (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MutablePrimArray s Word8
mba

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 = (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (IO CSize -> CSize) -> IO CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (IO CSize -> Int) -> IO CSize -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
V.c_strlen Addr#
addr0#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    go :: Addr# -> CBytes
go Addr#
addr# = (forall s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s CBytes) -> CBytes)
-> (forall s. ST s CBytes) -> CBytes
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
marr <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Ptr Word8 -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
marr Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
        PrimArray Word8
arr <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
marr
        CBytes -> ST s CBytes
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 s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s CBytes) -> CBytes)
-> (forall s. ST s CBytes) -> CBytes
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s Word8
mba <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
V.defaultInitSize
    (SP2 Int
i MutablePrimArray s Word8
mba') <- (SP2 s -> Char -> ST s (SP2 s)) -> SP2 s -> String -> ST s (SP2 s)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM SP2 s -> Char -> ST s (SP2 s)
forall s. SP2 s -> Char -> ST s (SP2 s)
go (Int -> MutablePrimArray s Word8 -> SP2 s
forall s. Int -> MutablePrimArray s Word8 -> SP2 s
SP2 Int
0 MutablePrimArray s Word8
mba) String
s
    MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba' Int
i Word8
0     -- the \\NUL terminator
    MutablePrimArray (PrimState (ST s)) Word8 -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    PrimArray Word8
ba <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba'
    CBytes -> ST s CBytes
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 :: SP2 s -> Char -> ST s (SP2 s)
go (SP2 Int
i MutablePrimArray s Word8
mba) !Char
c     = do
        Int
siz <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siz Int -> Int -> Int
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' <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeCharModifiedUTF8 MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba Int
i Char
c
            SP2 s -> ST s (SP2 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MutablePrimArray s Word8 -> SP2 s
forall s. Int -> MutablePrimArray s Word8 -> SP2 s
SP2 Int
i' MutablePrimArray s Word8
mba)
        else do
            let !siz' :: Int
siz' = Int
siz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
            !MutablePrimArray s Word8
mba' <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba Int
siz'
            Int
i' <- MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Char -> ST s Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
encodeCharModifiedUTF8 MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mba' Int
i Char
c
            SP2 s -> ST s (SP2 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MutablePrimArray s Word8 -> SP2 s
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 = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> String
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = []
        | Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
idx Int -> Int -> Bool
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 Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)

unpackFB :: CBytes -> (Char -> a -> a) -> a -> a
{-# INLINE [0] unpackFB #-}
unpackFB :: 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 = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = a
z
        | Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
idx Int -> Int -> Bool
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 Int -> Int -> Int
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) = PrimArray Word8 -> Int -> Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
pa Int
0 Word8 -> Word8 -> Bool
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) = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa Int -> Int -> Int
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
{-# INLINABLE toBytes #-}
toBytes :: CBytes -> Bytes
toBytes (CBytes PrimArray Word8
arr) = PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 (PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | /O(1)/, convert to 'V.Bytes' with its NULL terminator.
toBytes' :: CBytes -> V.Bytes
{-# INLINABLE toBytes' #-}
toBytes' :: CBytes -> Bytes
toBytes' (CBytes PrimArray Word8
arr) = PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 (PrimArray Word8 -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool -> Bool -> Bool
&& PrimArray Word8 -> Int -> Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word8
arr Int
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 =
        PrimArray Word8 -> CBytes
CBytes PrimArray Word8
arr
    | Bool
otherwise = (forall s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST (do
        let l' :: Int
l' = case Word8 -> Bytes -> Maybe Int
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 <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
l'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
0 PrimArray Word8
arr Int
s Int
l'
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa Int
l' Word8
0      -- the \\NUL terminator
        PrimArray Word8
pa <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
mpa
        CBytes -> ST s CBytes
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
{-# INLINABLE toText #-}
toText :: CBytes -> Text
toText = HasCallStack => Bytes -> Text
Bytes -> Text
T.validate (Bytes -> Text) -> (CBytes -> Bytes) -> CBytes -> Text
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
{-# INLINABLE toTextMaybe #-}
toTextMaybe :: CBytes -> Maybe Text
toTextMaybe = Bytes -> Maybe Text
T.validateMaybe (Bytes -> Maybe Text) -> (CBytes -> Bytes) -> CBytes -> Maybe Text
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
{-# INLINABLE fromText #-}
fromText :: Text -> CBytes
fromText = Bytes -> CBytes
fromBytes (Bytes -> CBytes) -> (Text -> Bytes) -> Text -> CBytes
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 ()
{-# INLINABLE toBuilder #-}
toBuilder :: CBytes -> Builder ()
toBuilder = Bytes -> Builder ()
B.bytes (Bytes -> Builder ()) -> (CBytes -> Bytes) -> CBytes -> Builder ()
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 ()
{-# INLINABLE toBuilder' #-}
toBuilder' :: CBytes -> Builder ()
toBuilder' = Bytes -> Builder ()
B.bytes (Bytes -> Builder ()) -> (CBytes -> Bytes) -> CBytes -> Builder ()
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
{-# INLINABLE buildCBytes #-}
buildCBytes :: Builder a -> CBytes
buildCBytes Builder a
b = Bytes -> CBytes
fromBytes (Builder () -> Bytes
forall a. Builder a -> Bytes
B.build (Builder a
b Builder a -> Builder () -> Builder ()
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 CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then CBytes -> IO CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
empty
    else do
        Int
len <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len'
        MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
0 (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstring) Int
len'
        PrimArray Word8
pa <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa
        CBytes -> IO CBytes
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 CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
len0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then CBytes -> IO CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
empty
    else do
        Int
len1 <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
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 -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len0 Int
len1
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
0 (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstring) Int
len
        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
len Word8
0     -- the \\NUL terminator
        PrimArray Word8
pa <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa
        CBytes -> IO CBytes
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 :: CBytes -> (ByteArray# -> IO a) -> IO a
withCBytesUnsafe (CBytes PrimArray Word8
pa) ByteArray# -> IO a
f = PrimArray Word8 -> (ByteArray# -> Int -> IO a) -> IO a
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 :: [CBytes] -> (BAArray# Word8 -> Int -> IO a) -> IO a
withCBytesListUnsafe [CBytes]
pas = [PrimArray Word8] -> (BAArray# Word8 -> Int -> IO a) -> IO a
forall a b.
[PrimArray a] -> (BAArray# Word8 -> Int -> IO b) -> IO b
withPrimArrayListUnsafe ((CBytes -> PrimArray Word8) -> [CBytes] -> [PrimArray Word8]
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 :: CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes (CBytes PrimArray Word8
pa) Ptr Word8 -> IO a
f = PrimArray Word8 -> (Ptr Word8 -> Int -> IO a) -> IO a
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 :: [CBytes] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
withCBytesList [CBytes]
pas = [PrimArray Word8] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
forall a b.
Prim a =>
[PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withPrimArrayListSafe ((CBytes -> PrimArray Word8) -> [CBytes] -> [PrimArray Word8]
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 :: Int -> (MBA# Word8 -> IO a) -> IO (CBytes, a)
allocCBytesUnsafe Int
n MBA# Word8 -> IO a
fill | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Word8 -> (MBA# Word8 -> IO a) -> IO (Word8, a)
forall a b. Prim a => a -> (MBA# Word8 -> IO b) -> IO (a, b)
withPrimUnsafe (Word8
0::Word8) MBA# Word8 -> IO a
fill IO (Word8, a) -> ((Word8, a) -> IO (CBytes, a)) -> IO (CBytes, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                        \ (Word8
_, a
b) -> (CBytes, a) -> IO (CBytes, a)
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#) <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
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 <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> IO Int -> IO Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Int
l
    MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba (Int
l'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
l' Word8
0
    PrimArray Word8
bs <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba
    (CBytes, a) -> IO (CBytes, a)
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 :: Int -> (CString -> IO a) -> IO (CBytes, a)
allocCBytes Int
n CString -> IO a
fill | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = CString -> IO a
fill CString
forall a. Ptr a
nullPtr IO a -> (a -> IO (CBytes, a)) -> IO (CBytes, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
a -> (CBytes, a) -> IO (CBytes, 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#) <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
n :: IO (MutablePrimArray RealWorld Word8)
    a
a <- MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
mba (CString -> IO a
fill (CString -> IO a) -> (Ptr Word8 -> CString) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr)
    Int
l <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> IO Int -> IO Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Int
l
    MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba (Int
l'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
l' Word8
0
    PrimArray Word8
bs <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba
    (CBytes, a) -> IO (CBytes, a)
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 = IO (Ptr StdString)
-> (Ptr StdString -> IO ())
-> (Ptr StdString -> IO CBytes)
-> IO CBytes
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        (PrimArray Word8
bs,()
_) <- Int -> (MBA# Word8 -> IO ()) -> IO (PrimArray Word8, ())
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')
        CBytes -> IO CBytes
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