{-# LANGUAGE CPP #-}

module PtrPoker.ByteString where

import Data.ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Builder.Extra as Builder
import Data.ByteString.Builder.Prim
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 :: AllocationStrategy -> Builder -> ByteString
builderWithStrategy AllocationStrategy
strategy Builder
builder =
  Builder
builder
    Builder -> (Builder -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& AllocationStrategy -> ByteString -> Builder -> ByteString
Builder.toLazyByteStringWith AllocationStrategy
strategy ByteString
Lazy.empty
    ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
Lazy.toStrict

scientific :: Scientific -> ByteString
scientific :: Scientific -> ByteString
scientific Scientific
sci =
  Scientific
sci
    Scientific -> (Scientific -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
& Scientific -> Builder
ScientificBuilder.scientificBuilder
    Builder -> (Builder -> ByteString) -> ByteString
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
          IO CInt -> (IO CInt -> IO Int) -> IO Int
forall a b. a -> (a -> b) -> b
& (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
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 =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
allocSize
    Int
actualSize <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr Word8 -> IO Int
populate (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int -> Int
forall a. Enum a => a -> a
pred Int
allocSize)))
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp (Int
allocSize Int -> Int -> Int
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 = (ByteArray# -> Int -> Int -> ByteString) -> Text -> ByteString
forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
Text.destruct ((ByteArray# -> Int -> Int -> ByteString) -> Text -> ByteString)
-> (ByteArray# -> Int -> Int -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ \ByteArray#
arr Int
off Int
len ->
  if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then ByteString
empty
    else Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) ((Ptr Word8 -> IO Int) -> ByteString)
-> (Ptr Word8 -> IO Int) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
      Ptr Word8
postPtr <- (Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8))
-> Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8)
forall a. a -> a
inline Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8)
Ffi.encodeText Ptr Word8
ptr ByteArray#
arr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
postPtr Ptr Word8
ptr)
#endif