module CString
    ( CString
    , CStr(..)
    , useCStr
    , fromBuilder
    , toBuilder
    ) where

import qualified Data.ByteString.Builder  as BB
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy     as LBS
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Zhp

-- | wrapper around a nul-terminated C style string; the pointer points to the
-- beginning of the string.
--
-- Users of the library will mostly not use this directly, instead using CString.
newtype CStr = CStr (Ptr CChar)

-- | A string for passing to C api functions. The C-compatible form is computed
-- lazily; it will not be forced until the string is passed to a C API function.
-- Internally, this is stored as a 'BB.Builder' with no trailing nul, so
-- performance characteristics are mostly the same, only requiring a copy when
-- first passing the string to an API function.
data CString = CString
    { CString -> Builder
bytes :: BB.Builder
    , CString -> ForeignPtr CChar
fptr  :: ForeignPtr CChar
    }

instance Semigroup CString where
    CString
x <> :: CString -> CString -> CString
<> CString
y = Builder -> CString
fromBuilder (CString -> Builder
toBuilder CString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CString -> Builder
toBuilder CString
y)

instance Monoid CString where
    mempty :: CString
mempty = Builder -> CString
fromBuilder Builder
forall a. Monoid a => a
mempty

-- | Convert a 'BB.Builder' to a CString. The builder should not have a nul
-- terminator; it will be added.
fromBuilder :: BB.Builder -> CString
fromBuilder :: Builder -> CString
fromBuilder Builder
builder = CString :: Builder -> ForeignPtr CChar -> CString
CString
    { bytes :: Builder
bytes = Builder
builder
    , fptr :: ForeignPtr CChar
fptr =
        let bs :: ByteString
bs = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
0)
            (ForeignPtr Word8
ptr, Int
off, Int
_len) = ByteString -> (ForeignPtr Word8, Int, Int)
BS.toForeignPtr ByteString
bs
        in
        ForeignPtr Word8 -> Int -> ForeignPtr CChar
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
ptr Int
off
    }

-- | Extract a bytestring builder for the string. Does not include the nul
-- terminator. O(1).
toBuilder :: CString -> BB.Builder
toBuilder :: CString -> Builder
toBuilder = CString -> Builder
bytes

-- | Use the raw pointer underlying the 'CString'.
useCStr :: CString -> (CStr -> IO a) -> IO a
useCStr :: CString -> (CStr -> IO a) -> IO a
useCStr CString
str CStr -> IO a
use =
    ForeignPtr CChar -> (Ptr CChar -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (CString -> ForeignPtr CChar
fptr CString
str) ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr -> CStr -> IO a
use (Ptr CChar -> CStr
CStr Ptr CChar
ptr)

instance IsString CString where
    fromString :: String -> CString
fromString = Builder -> CString
fromBuilder (Builder -> CString) -> (String -> Builder) -> String -> CString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Builder
BB.stringUtf8