{-# LANGUAGE UnliftedFFITypes #-}

-- |
-- Module      : Streamly.Internal.Data.CString
-- Copyright   : (c) 2023 Composewell Technologies
-- License     : BSD3-3-Clause
-- Maintainer  : streamly@composewell.com
-- Portability : GHC
--
-- MutByteArray representing null terminated c strings.
-- All APIs in this module are unsafe and caution must be used when using them.
-- Completely experimental. Everything is subject to change without notice.

module Streamly.Internal.Data.CString
    (
      splice
    , spliceCString
    , splicePtrN
    , putCString
    , length
    )

where

#ifdef DEBUG
#include "assert.hs"
#endif

import GHC.Ptr (Ptr(..), castPtr)
import Foreign.C (CString, CSize(..))
import GHC.Exts (MutableByteArray#, RealWorld)
import GHC.Word (Word8)

import Streamly.Internal.Data.MutByteArray.Type hiding (length)

import Prelude hiding (length)

-- XXX Use cstringLength# from GHC.CString in ghc-prim
foreign import ccall unsafe "string.h strlen" c_strlen
    :: MutableByteArray# RealWorld -> IO CSize

-- XXX Use cstringLength# from GHC.CString in ghc-prim
foreign import ccall unsafe "string.h strlen" c_strlen_pinned
    :: CString -> IO CSize

{-# INLINE length #-}
length :: MutByteArray -> IO Int
length :: MutByteArray -> IO Int
length (MutByteArray MutableByteArray# RealWorld
src#) = do
    (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO CSize
c_strlen MutableByteArray# RealWorld
src#

-- | Join two null terminated cstrings, the null byte of the first string is
-- overwritten. Does not check the destination length or source length.
-- Destination must have enough space to accomodate src.
--
-- Returns the offset of the null byte.
--
-- /Unsafe/
splice :: MutByteArray -> MutByteArray -> IO Int
splice :: MutByteArray -> MutByteArray -> IO Int
splice dst :: MutByteArray
dst@(MutByteArray MutableByteArray# RealWorld
dst#) src :: MutByteArray
src@(MutByteArray MutableByteArray# RealWorld
src#) = do
    Int
srcLen <- (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO CSize
c_strlen MutableByteArray# RealWorld
src#
#ifdef DEBUG
    srcLen1 <- length src
    assertM(srcLen <= srcLen1)
#endif
    Int
dstLen <- (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO CSize
c_strlen MutableByteArray# RealWorld
dst#
#ifdef DEBUG
    dstLen1 <- length dst
    assertM(dstLen <= dstLen1)
    assertM(dstLen + srcLen + 1 <= dstLen1)
#endif
    MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
unsafePutSlice MutByteArray
src Int
0 MutByteArray
dst Int
dstLen (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen

-- | Append specified number of bytes from a Ptr to a MutByteArray CString. The
-- null byte of CString is overwritten and the result is terminated with a null
-- byte.
{-# INLINE splicePtrN #-}
splicePtrN :: MutByteArray -> Ptr Word8 -> Int -> IO Int
splicePtrN :: MutByteArray -> Ptr Word8 -> Int -> IO Int
splicePtrN dst :: MutByteArray
dst@(MutByteArray MutableByteArray# RealWorld
dst#) Ptr Word8
src Int
srcLen = do
    Int
dstLen <- (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO CSize
c_strlen MutableByteArray# RealWorld
dst#
#ifdef DEBUG
    dstLen1 <- length dst
    assertM(dstLen <= dstLen1)
    assertM(dstLen + srcLen + 1 <= dstLen1)
#endif
    -- unsafePutSlice src 0 dst dstLen srcLen
    -- XXX unsafePutPtrN signature consistency with serialization routines
    -- XXX unsafePutSlice as well
    Ptr Word8 -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr Word8 -> MutByteArray -> Int -> Int -> m ()
unsafePutPtrN Ptr Word8
src MutByteArray
dst Int
dstLen (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen

-- | Join a null terminated cstring MutByteByteArray with a null terminated
-- cstring Ptr.
{-# INLINE spliceCString #-}
spliceCString :: MutByteArray -> CString -> IO Int
spliceCString :: MutByteArray -> CString -> IO Int
spliceCString MutByteArray
dst CString
src = do
    Int
srcLen <- (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ CString -> IO CSize
c_strlen_pinned CString
src
    MutByteArray -> Ptr Word8 -> Int -> IO Int
splicePtrN MutByteArray
dst (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
src) Int
srcLen

-- XXX this is CString serialization.

-- | @putCString dst dstOffset cstr@ writes the cstring cstr at dstOffset in
-- the dst MutByteArray. The result is terminated by a null byte.
{-# INLINE putCString #-}
putCString :: MutByteArray -> Int -> CString -> IO Int
putCString :: MutByteArray -> Int -> CString -> IO Int
putCString MutByteArray
dst Int
off CString
src = do
    Int
srcLen <- (CSize -> Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> IO Int) -> IO CSize -> IO Int
forall a b. (a -> b) -> a -> b
$ CString -> IO CSize
c_strlen_pinned CString
src
    Ptr Word8 -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr Word8 -> MutByteArray -> Int -> Int -> m ()
unsafePutPtrN (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
src) MutByteArray
dst Int
off (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen