{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module PtrPoker.ByteString where

import Data.ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Builder.Extra as Builder
import qualified Data.ByteString.Builder.Scientific as ScientificBuilder
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Text.Encoding as TextEncoding
import qualified PtrPoker.Ffi as Ffi
import PtrPoker.Prelude hiding (empty)
import qualified PtrPoker.Text as Text

builderWithStrategy :: Builder.AllocationStrategy -> Builder.Builder -> ByteString
builderWithStrategy :: AllocationStrategy -> Builder -> ByteString
builderWithStrategy AllocationStrategy
strategy Builder
builder =
  Builder
builder
    forall a b. a -> (a -> b) -> b
& AllocationStrategy -> ByteString -> Builder -> ByteString
Builder.toLazyByteStringWith AllocationStrategy
strategy ByteString
Lazy.empty
    forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
Lazy.toStrict

scientific :: Scientific -> ByteString
scientific :: Scientific -> ByteString
scientific Scientific
sci =
  Scientific
sci
    forall a b. a -> (a -> b) -> b
& Scientific -> Builder
ScientificBuilder.scientificBuilder
    forall a b. a -> (a -> b) -> b
& AllocationStrategy -> Builder -> ByteString
builderWithStrategy (Int -> Int -> AllocationStrategy
Builder.untrimmedStrategy Int
128 Int
128)

double :: Double -> ByteString
double :: Double -> ByteString
double Double
dbl =
  Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN
    Int
25
    ( \Ptr Word8
ptr ->
        Double -> Ptr Word8 -> IO CInt
Ffi.pokeDouble Double
dbl Ptr Word8
ptr
          forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral
    )

unsafeCreateDownToN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateDownToN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateDownToN Int
allocSize Ptr Word8 -> IO Int
populate =
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
allocSize
    Int
actualSize <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr Word8 -> IO Int
populate (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (forall a. Enum a => a -> a
pred Int
allocSize)))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp (Int
allocSize forall a. Num a => a -> a -> a
- Int
actualSize) Int
actualSize

{-# INLINEABLE textUtf8 #-}
textUtf8 :: Text -> ByteString
#if MIN_VERSION_text(2,0,0)
textUtf8 t = TextEncoding.encodeUtf8 t
#else
textUtf8 :: Text -> ByteString
textUtf8 = forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
Text.destruct forall a b. (a -> b) -> a -> b
$ \ByteArray#
arr Int
off Int
len ->
  if Int
len forall a. Eq a => a -> a -> Bool
== Int
0
    then ByteString
empty
    else Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN (Int
len forall a. Num a => a -> a -> a
* Int
3) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
      Ptr Word8
postPtr <- forall a. a -> a
inline Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8)
Ffi.encodeText Ptr Word8
ptr ByteArray#
arr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
postPtr Ptr Word8
ptr)
#endif