{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-|
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 provide 'CBytes' with some useful instances \/ functions, A 'CBytes' is a
wrapper for immutable null-terminated string.
The main design target 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.

We neither guarantee to store length info, nor support O(1) slice for 'CBytes':
This will defeat the purpose of null-terminated string which is to save memory,
We do save the length if it's created on GHC heap though. If you need advance editing,
convert a 'CBytes' to 'V.Bytes' with 'toBytes' and use vector combinators.
Use 'fromBytes' to convert it back.

It can be used with @OverloadedString@, literal encoding is UTF-8 with some modifications:
@\NUL@ char is encoded to 'C0 80', and '\xD800' ~ '\xDFFF' is encoded as a three bytes
normal utf-8 codepoint. This is also how ghc compile string literal into binaries,
thus we can use rewrite-rules to construct 'CBytes' value in O(1) without wasting runtime heap.

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 everywhere, and we use UTF-8 assumption in
various places, such as displaying 'CBytes' and literals encoding above.

-}

module Z.Data.CBytes
  ( CBytes
  , create
  , pack
  , unpack
  , null , length
  , empty, append, concat, intercalate, intercalateElem
  , toBytes, fromBytes, toText, toTextMaybe, fromText
  , fromCStringMaybe, fromCString, fromCStringN
  , withCBytes
  -- helpers re-export
  , V.w2c, V.c2w
  -- * exception
  , NullPointerException(..)
  ) where

import           Control.DeepSeq
import           Control.Exception (Exception, throwIO)
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.String             (IsString (..))
import           Data.Typeable
import           Data.Primitive.PrimArray
import           Data.Word
import           Foreign.C
import           Foreign.Storable        (peekElemOff)
import           GHC.CString
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           Z.Data.Array
import qualified Z.Data.Text           as T
import           Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8)
import qualified Z.Data.Vector.Base    as V
import           System.IO.Unsafe        (unsafeDupablePerformIO)

-- | A efficient wrapper for immutable null-terminated string which can be
-- automatically freed by ghc garbage collector.
--
data CBytes
    = CBytesOnHeap  {-# UNPACK #-} !(PrimArray Word8)   -- ^ On heap pinned 'PrimArray'
                                                        -- there's an invariance that this array's
                                                        -- length is always shrinked to contain content
                                                        -- and \NUL terminator
    | CBytesLiteral {-# UNPACK #-} !CString             -- ^ String literals with static address

-- | Create a 'CBytes' with IO action.
--
-- User only have to do content initialization and return the content length,
-- 'create' takes the responsibility to add the '\NUL' ternimator.
create :: HasCallStack
       => Int  -- ^ capacity n, including the '\NUL' terminator
       -> (CString -> IO Int)  -- ^ initialization function,
                               -- write the pointer, return the length (<= n-1)
       -> IO CBytes
{-# INLINE create #-}
create :: Int -> (CString -> IO Int) -> IO CBytes
create Int
n CString -> IO Int
fill = do
    MutablePrimArray RealWorld 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)
    Int
l <- MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
mba (CString -> IO Int
fill (CString -> IO Int)
-> (Ptr Word8 -> CString) -> Ptr Word8 -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr)
    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 -- the '\NUL' ternimator
    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
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    PrimArray Word8 -> CBytes
CBytesOnHeap (PrimArray Word8 -> CBytes) -> IO (PrimArray Word8) -> IO CBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

instance Show CBytes where
    show :: CBytes -> String
show = CBytes -> String
unpack

instance Read CBytes where
    readsPrec :: Int -> ReadS CBytes
readsPrec Int
p String
s = [(String -> CBytes
pack String
x, String
r) | (String
x, String
r) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s]

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

instance Eq CBytes where
    {-# INLINE (==) #-}
    CBytes
cbyteA == :: CBytes -> CBytes -> Bool
== CBytes
cbyteB = IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        CBytes -> (CString -> IO Bool) -> IO Bool
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
cbyteA ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ CString
pA ->
        CBytes -> (CString -> IO Bool) -> IO Bool
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
cbyteB ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ CString
pB ->
            if CString
pA CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
pB
            then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            else do
                CInt
r <- CString -> CString -> IO CInt
c_strcmp CString
pA CString
pB
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

instance Ord CBytes where
    {-# INLINE compare #-}
    CBytes
cbyteA compare :: CBytes -> CBytes -> Ordering
`compare` CBytes
cbyteB = IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
        CBytes -> (CString -> IO Ordering) -> IO Ordering
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
cbyteA ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \ CString
pA ->
        CBytes -> (CString -> IO Ordering) -> IO Ordering
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
cbyteB ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \ CString
pB ->
            if CString
pA CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
pB
            then Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
            else do
                CInt
r <- CString -> CString -> IO CInt
c_strcmp CString
pA CString
pB
                Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CInt
0)

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 (CBytesOnHeap 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
    hashWithSalt Int
salt (CBytesLiteral p :: CString
p@(Ptr Addr#
addr#)) = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
        CSize
len <- CString -> IO CSize
c_strlen CString
p
        Addr# -> Int -> Int -> IO Int
V.c_fnv_hash_addr Addr#
addr# (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len) Int
salt

append :: CBytes -> CBytes -> CBytes
{-# INLINABLE append #-}
append :: CBytes -> CBytes -> CBytes
append CBytes
strA CBytes
strB
    | 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)
newPinnedPrimArray (Int
lenAInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenBInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        CBytes -> (CString -> IO CBytes) -> IO CBytes
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
strA ((CString -> IO CBytes) -> IO CBytes)
-> (CString -> IO CBytes) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \ CString
pa ->
            CBytes -> (CString -> IO CBytes) -> IO CBytes
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
strB ((CString -> IO CBytes) -> IO CBytes)
-> (CString -> IO CBytes) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \ CString
pb -> do
                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
pa) Int
lenA
                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
lenA (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
pb) 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
CBytesOnHeap PrimArray Word8
pa')
  where
    lenA :: Int
lenA = CBytes -> Int
length CBytes
strA
    lenB :: Int
lenB = CBytes -> Int
length CBytes
strB

empty :: CBytes
{-# NOINLINE empty #-}
empty :: CBytes
empty = CString -> CBytes
CBytesLiteral (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"\0"#)

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)
newPinnedPrimArray (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
CBytesOnHeap (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 (CBytes
b:[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) (case CBytes
b of
            CBytesOnHeap PrimArray Word8
ba ->
                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
            CBytesLiteral CString
p ->
                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
mba Int
i (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
p) 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.
--
intercalateElem :: Word8 -> [CBytes] -> CBytes
{-# INLINABLE intercalateElem #-}
intercalateElem :: Word8 -> [CBytes] -> CBytes
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)
newPinnedPrimArray (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
CBytesOnHeap (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 (CBytes
b:[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) (case CBytes
b of
            CBytesOnHeap PrimArray Word8
ba ->
                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
            CBytesLiteral CString
p ->
                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
mba Int
i (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
p) 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#) = CBytesLiteral (Ptr addr#)
 #-}
{-# RULES
    "CBytes pack/unpackCStringUtf8#" forall addr# .
        pack (unpackCStringUtf8# addr#) = CBytesLiteral (Ptr addr#)
 #-}

-- | Pack a 'String' into null-terminated '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)
newPinnedPrimArray 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
CBytesOnHeap 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 5 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)

unpack :: CBytes -> String
{-# INLINABLE unpack #-}
-- TODO: rewrite with our own decoder
unpack :: CBytes -> String
unpack CBytes
cbytes = IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (IO String -> String)
-> ((CString -> IO String) -> IO String)
-> (CString -> IO String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (CString -> IO String) -> IO String
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
cbytes ((CString -> IO String) -> String)
-> (CString -> IO String) -> String
forall a b. (a -> b) -> a -> b
$ \ (Ptr Addr#
addr#) ->
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr# -> String
unpackCStringUtf8# Addr#
addr#)

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

null :: CBytes -> Bool
{-# INLINE null #-}
null :: CBytes -> Bool
null (CBytesOnHeap 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
null (CBytesLiteral CString
p) = IO CChar -> CChar
forall a. IO a -> a
unsafeDupablePerformIO (CString -> Int -> IO CChar
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff CString
p Int
0) CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
== CChar
0

length :: CBytes -> Int
{-# INLINE length #-}
length :: CBytes -> Int
length (CBytesOnHeap 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
length (CBytesLiteral CString
p) = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (CString -> IO CSize
c_strlen CString
p)

-- | /O(1)/, (/O(n)/ in case of literal), convert to 'V.Bytes', which can be
-- processed by vector combinators.
--
-- NOTE: the '\NUL' ternimator is not included.
toBytes :: CBytes -> V.Bytes
{-# INLINABLE toBytes #-}
toBytes :: CBytes -> Bytes
toBytes cbytes :: CBytes
cbytes@(CBytesOnHeap PrimArray Word8
pa) = PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
pa Int
0 Int
l
  where l :: Int
l = CBytes -> Int
length CBytes
cbytes
toBytes cbytes :: CBytes
cbytes@(CBytesLiteral CString
p) = Int
-> (forall s. MArr (IArray PrimVector) s Word8 -> ST s ()) -> Bytes
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (\ MArr (IArray PrimVector) s Word8
mpa -> do
    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 (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mpa Int
0 (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
p) 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 (PrimState (ST s)) Word8
MArr (IArray PrimVector) s Word8
mpa Int
l Word8
0)    -- the \NUL terminator
  where l :: Int
l = CBytes -> Int
length CBytes
cbytes

-- | /O(n)/, convert from 'V.Bytes', allocate pinned memory and
-- add the '\NUL' ternimator
fromBytes :: V.Bytes -> CBytes
{-# INLINABLE fromBytes #-}
fromBytes :: Bytes -> CBytes
fromBytes (V.Vec IArray PrimVector Word8
arr Int
s Int
l) =  (forall s. ST s CBytes) -> CBytes
forall a. (forall s. ST s a) -> a
runST (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)
newPinnedPrimArray (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
IArray PrimVector 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
CBytesOnHeap PrimArray Word8
pa))

-- | /O(n)/, convert to 'T.Text' using UTF8 encoding assumption.
--
-- Throw 'T.InvalidUTF8Exception' in case of invalid codepoint.
toText :: 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', allocate pinned memory and
-- add the '\NUL' ternimator
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

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

-- | Copy a 'CString' type into a 'CBytes', return Nothing if the pointer is NULL.
--
--  After copying you're free to free the 'CString' 's memory.
--
fromCStringMaybe :: HasCallStack => CString -> IO (Maybe CBytes)
{-# INLINABLE fromCStringMaybe #-}
fromCStringMaybe :: CString -> IO (Maybe CBytes)
fromCStringMaybe CString
cstring =
    if CString
cstring CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CBytes
forall a. Maybe a
Nothing
    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 CString
cstring
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (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
        Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes -> Maybe CBytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> CBytes
CBytesOnHeap PrimArray Word8
pa))


-- | Same with 'fromCStringMaybe', but throw 'NullPointerException' when meet a null pointer.
--
fromCString :: HasCallStack
            => 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 NullPointerException -> IO CBytes
forall e a. Exception e => e -> IO a
throwIO (CallStack -> NullPointerException
NullPointerException CallStack
HasCallStack => CallStack
callStack)
    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 CString
cstring
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (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
CBytesOnHeap PrimArray Word8
pa)

-- | Same with 'fromCString', but only take N bytes (and append a null byte as terminator).
--
fromCStringN :: HasCallStack
            => CString
            -> Int
            -> IO CBytes
{-# INLINABLE fromCStringN #-}
fromCStringN :: CString -> Int -> IO CBytes
fromCStringN CString
cstring Int
len = do
    if CString
cstring CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then NullPointerException -> IO CBytes
forall e a. Exception e => e -> IO a
throwIO (CallStack -> NullPointerException
NullPointerException CallStack
HasCallStack => CallStack
callStack)
    else do
        MutablePrimArray RealWorld Word8
mpa <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (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
CBytesOnHeap PrimArray Word8
pa)

data NullPointerException = NullPointerException CallStack deriving (Int -> NullPointerException -> ShowS
[NullPointerException] -> ShowS
NullPointerException -> String
(Int -> NullPointerException -> ShowS)
-> (NullPointerException -> String)
-> ([NullPointerException] -> ShowS)
-> Show NullPointerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullPointerException] -> ShowS
$cshowList :: [NullPointerException] -> ShowS
show :: NullPointerException -> String
$cshow :: NullPointerException -> String
showsPrec :: Int -> NullPointerException -> ShowS
$cshowsPrec :: Int -> NullPointerException -> ShowS
Show, Typeable)
instance Exception NullPointerException

-- | 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 -> (CString -> IO a) -> IO a
{-# INLINABLE withCBytes #-}
withCBytes :: CBytes -> (CString -> IO a) -> IO a
withCBytes (CBytesOnHeap PrimArray Word8
pa) CString -> IO a
f = PrimArray Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. PrimArray a -> (Ptr a -> IO b) -> IO b
withPrimArrayContents PrimArray Word8
pa (CString -> IO a
f (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)
withCBytes (CBytesLiteral CString
ptr) CString -> IO a
f = CString -> IO a
f CString
ptr

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

c_strcmp :: CString -> CString -> IO CInt
{-# INLINE c_strcmp #-}
c_strcmp :: CString -> CString -> IO CInt
c_strcmp (Ptr Addr#
a#) (Ptr Addr#
b#) = Addr# -> Addr# -> IO CInt
V.c_strcmp Addr#
a# Addr#
b#

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