{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
{-# LANGUAGE UnliftedFFITypes, MagicHash,
            UnboxedTuples #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.ByteString.Internal.Type
-- Copyright   : (c) Don Stewart 2006-2008
--               (c) Duncan Coutts 2006-2012
-- License     : BSD-style
-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org
-- Stability   : unstable
-- Portability : non-portable
--
-- The 'ByteString' type, its instances, and whatever related
-- utilities the bytestring developers see fit to use internally.
--
module Data.ByteString.Internal.Type (

        -- * The @ByteString@ type and representation
        ByteString
        ( BS
        , PS -- backwards compatibility shim
        ),

        StrictByteString,

        -- * Internal indexing
        findIndexOrLength,

        -- * Conversion with lists: packing and unpacking
        packBytes, packUptoLenBytes, unsafePackLenBytes,
        packChars, packUptoLenChars, unsafePackLenChars,
        unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,
        unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,
        unsafePackAddress, unsafePackLenAddress,
        unsafePackLiteral, unsafePackLenLiteral,

        -- * Low level imperative construction
        empty,
        createFp,
        createFpUptoN,
        createFpUptoN',
        createFpAndTrim,
        createFpAndTrim',
        unsafeCreateFp,
        unsafeCreateFpUptoN,
        unsafeCreateFpUptoN',
        create,
        createUptoN,
        createUptoN',
        createAndTrim,
        createAndTrim',
        unsafeCreate,
        unsafeCreateUptoN,
        unsafeCreateUptoN',
        mallocByteString,

        -- * Conversion to and from ForeignPtrs
        mkDeferredByteString,
        fromForeignPtr,
        toForeignPtr,
        fromForeignPtr0,
        toForeignPtr0,

        -- * Utilities
        nullForeignPtr,
        peekFp,
        pokeFp,
        peekFpByteOff,
        pokeFpByteOff,
        minusForeignPtr,
        memcpyFp,
        deferForeignPtrAvailability,
        unsafeDupablePerformIO,
        SizeOverflowException,
        overflowError,
        checkedAdd,
        checkedMultiply,

        -- * Standard C Functions
        c_strlen,
        c_free_finalizer,

        memchr,
        memcmp,
        memcpy,
        memset,

        -- * cbits functions
        c_reverse,
        c_intersperse,
        c_maximum,
        c_minimum,
        c_count,
        c_sort,

        -- * Chars
        w2c, c2w, isSpaceWord8, isSpaceChar8,

        -- * Deprecated and unmentionable
        accursedUnutterablePerformIO,

        -- * Exported compatibility shim
        plusForeignPtr,
        unsafeWithForeignPtr
  ) where

import Prelude hiding (concat, null)
import qualified Data.List as List

import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)
import Foreign.Ptr              (Ptr, FunPtr, plusPtr)
import Foreign.Storable         (Storable(..))
import Foreign.C.Types          (CInt(..), CSize(..))
import Foreign.C.String         (CString)
import Foreign.Marshal.Utils

#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup           (Semigroup ((<>)))
#endif
import Data.Semigroup           (Semigroup (sconcat, stimes))
import Data.List.NonEmpty       (NonEmpty ((:|)))

import Control.DeepSeq          (NFData(rnf))

import Data.String              (IsString(..))

import Control.Exception        (assert, throw, Exception)

import Data.Bits                ((.&.))
import Data.Char                (ord)
import Data.Word

import Data.Data                (Data(..), mkNoRepType)

import GHC.Base                 (nullAddr#,realWorld#,unsafeChr)
import GHC.Exts                 (IsList(..), Addr#, minusAddr#)
import GHC.CString              (unpackCString#)
import GHC.Magic                (runRW#, lazy)

#define TIMES_INT_2_AVAILABLE MIN_VERSION_ghc_prim(0,7,0)
#if TIMES_INT_2_AVAILABLE
import GHC.Prim                (timesInt2#)
#else
import GHC.Prim                ( timesWord2#
                               , or#
                               , uncheckedShiftRL#
                               , int2Word#
                               , word2Int#
                               )
import Data.Bits               (finiteBitSize)
#endif

import GHC.IO                   (IO(IO))
import GHC.ForeignPtr           (ForeignPtr(ForeignPtr)
#if __GLASGOW_HASKELL__ < 900
                                , newForeignPtr_
#endif
                                , mallocPlainForeignPtrBytes)

#if MIN_VERSION_base(4,10,0)
import GHC.ForeignPtr           (plusForeignPtr)
#else
import GHC.Prim                 (plusAddr#)
#endif

#if __GLASGOW_HASKELL__ >= 811
import GHC.CString              (cstringLength#)
import GHC.ForeignPtr           (ForeignPtrContents(FinalPtr))
#else
import GHC.Ptr                  (Ptr(..))
#endif

import GHC.Types                (Int (..))

#if MIN_VERSION_base(4,15,0)
import GHC.ForeignPtr           (unsafeWithForeignPtr)
#endif

import qualified Language.Haskell.TH.Lib as TH
import qualified Language.Haskell.TH.Syntax as TH

#if !MIN_VERSION_base(4,15,0)
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = withForeignPtr
#endif

-- CFILES stuff is Hugs only
{-# CFILES cbits/fpstring.c #-}

#if !MIN_VERSION_base(4,10,0)
-- |Advances the given address by the given offset in bytes.
--
-- The new 'ForeignPtr' shares the finalizer of the original,
-- equivalent from a finalization standpoint to just creating another
-- reference to the original. That is, the finalizer will not be
-- called before the new 'ForeignPtr' is unreachable, nor will it be
-- called an additional time due to this call, and the finalizer will
-- be called with the same address that it would have had this call
-- not happened, *not* the new address.
plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts
{-# INLINE [0] plusForeignPtr #-}
{-# RULES
"ByteString plusForeignPtr/0" forall fp .
   plusForeignPtr fp 0 = fp
 #-}
#endif

minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
minusForeignPtr :: forall a b. ForeignPtr a -> ForeignPtr b -> Int
minusForeignPtr (ForeignPtr Addr#
addr1 ForeignPtrContents
_) (ForeignPtr Addr#
addr2 ForeignPtrContents
_)
  = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
addr1 Addr#
addr2)

peekFp :: Storable a => ForeignPtr a -> IO a
peekFp :: forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr a
fp = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a. Storable a => Ptr a -> IO a
peek

pokeFp :: Storable a => ForeignPtr a -> a -> IO ()
pokeFp :: forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr a
fp a
val = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
p a
val

peekFpByteOff :: Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff :: forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr a
fp Int
off = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
  forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
p Int
off

pokeFpByteOff :: Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff :: forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
fp Int
off a
val = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
fp forall a b. (a -> b) -> a -> b
$ \Ptr b
p ->
  forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p Int
off a
val

-- | Most operations on a 'ByteString' need to read from the buffer
-- given by its @ForeignPtr Word8@ field.  But since most operations
-- on @ByteString@ are (nominally) pure, their implementations cannot
-- see the IO state thread that was used to initialize the contents of
-- that buffer.  This means that under some circumstances, these
-- buffer-reads may be executed before the writes used to initialize
-- the buffer are executed, with unpredictable results.
--
-- 'deferForeignPtrAvailability' exists to help solve this problem.
-- At runtime, a call @'deferForeignPtrAvailability' x@ is equivalent
-- to @pure $! x@, but the former is more opaque to the simplifier, so
-- that reads from the pointer in its result cannot be executed until
-- the @'deferForeignPtrAvailability' x@ call is complete.
--
-- The opaque bits evaporate during CorePrep, so using
-- 'deferForeignPtrAvailability' incurs no direct overhead.
--
-- @since 0.11.5.0
deferForeignPtrAvailability :: ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability :: forall a. ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability (ForeignPtr Addr#
addr0# ForeignPtrContents
guts) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  case forall a. a -> a
lazy forall o. (State# RealWorld -> o) -> o
runRW# (\State# RealWorld
_ -> (# State# RealWorld
s0, Addr#
addr0# #)) of
    (# State# RealWorld
s1, Addr#
addr1# #) -> (# State# RealWorld
s1, forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr1# ForeignPtrContents
guts #)

-- | Variant of 'fromForeignPtr0' that calls 'deferForeignPtrAvailability'
--
-- @since 0.11.5.0
mkDeferredByteString :: ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString :: ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
len = do
  ForeignPtr Word8
deferredFp <- forall a. ForeignPtr a -> IO (ForeignPtr a)
deferForeignPtrAvailability ForeignPtr Word8
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
deferredFp Int
len

unsafeDupablePerformIO :: IO a -> a
-- Why does this exist? In base-4.15.1.0 until at least base-4.18.0.0,
-- the version of unsafeDupablePerformIO in base prevents unboxing of
-- its results with an opaque call to GHC.Exts.lazy, for reasons described
-- in Note [unsafePerformIO and strictness] in GHC.IO.Unsafe. (See
-- https://hackage.haskell.org/package/base-4.18.0.0/docs/src/GHC.IO.Unsafe.html#line-30 .)
-- Even if we accept the (very questionable) premise that the sort of
-- function described in that note should work, we expect no such
-- calls to be made in the context of bytestring.  (And we really want
-- unboxing!)
unsafeDupablePerformIO :: forall a. IO a -> a
unsafeDupablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
act) = case forall o. (State# RealWorld -> o) -> o
runRW# State# RealWorld -> (# State# RealWorld, a #)
act of (# State# RealWorld
_, a
res #) -> a
res



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

-- | A space-efficient representation of a 'Word8' vector, supporting many
-- efficient operations.
--
-- A 'ByteString' contains 8-bit bytes, or by using the operations from
-- "Data.ByteString.Char8" it can be interpreted as containing 8-bit
-- characters.
--
data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload
                     {-# UNPACK #-} !Int                -- length
                     -- ^ @since 0.11.0.0

-- | Type synonym for the strict flavour of 'ByteString'.
--
-- @since 0.11.2.0
type StrictByteString = ByteString

-- |
-- @'PS' foreignPtr offset length@ represents a 'ByteString' with data
-- backed by a given @foreignPtr@, starting at a given @offset@ in bytes
-- and of a specified @length@.
--
-- This pattern is used to emulate the legacy 'ByteString' data
-- constructor, so that pre-existing code generally doesn't need to
-- change to benefit from the simplified 'BS' constructor and can
-- continue to function unchanged.
--
-- /Note:/ Matching with this constructor will always be given a 0 offset,
-- as the base will be manipulated by 'plusForeignPtr' instead.
--
pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString
pattern $bPS :: ForeignPtr Word8 -> Int -> Int -> ByteString
$mPS :: forall {r}.
ByteString
-> (ForeignPtr Word8 -> Int -> Int -> r) -> ((# #) -> r) -> r
PS fp zero len <- BS fp ((0,) -> (zero, len)) where
  PS ForeignPtr Word8
fp Int
o Int
len = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o) Int
len
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE PS #-}
#endif

instance Eq  ByteString where
    == :: ByteString -> ByteString -> Bool
(==)    = ByteString -> ByteString -> Bool
eq

instance Ord ByteString where
    compare :: ByteString -> ByteString -> Ordering
compare = ByteString -> ByteString -> Ordering
compareBytes

instance Semigroup ByteString where
    <> :: ByteString -> ByteString -> ByteString
(<>)    = ByteString -> ByteString -> ByteString
append
    sconcat :: NonEmpty ByteString -> ByteString
sconcat (ByteString
b:|[ByteString]
bs) = [ByteString] -> ByteString
concat (ByteString
bforall a. a -> [a] -> [a]
:[ByteString]
bs)
    {-# INLINE stimes #-}
    stimes :: forall b. Integral b => b -> ByteString -> ByteString
stimes  = forall b. Integral b => b -> ByteString -> ByteString
stimesPolymorphic

instance Monoid ByteString where
    mempty :: ByteString
mempty  = ByteString
empty
    mappend :: ByteString -> ByteString -> ByteString
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [ByteString] -> ByteString
mconcat = [ByteString] -> ByteString
concat

instance NFData ByteString where
    rnf :: ByteString -> ()
rnf BS{} = ()

instance Show ByteString where
    showsPrec :: Int -> ByteString -> ShowS
showsPrec Int
p ByteString
ps String
r = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (ByteString -> String
unpackChars ByteString
ps) String
r

instance Read ByteString where
    readsPrec :: Int -> ReadS ByteString
readsPrec Int
p String
str = [ (String -> ByteString
packChars String
x, String
y) | (String
x, String
y) <- forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]

-- | @since 0.10.12.0
instance IsList ByteString where
  type Item ByteString = Word8
  fromList :: [Item ByteString] -> ByteString
fromList = [Word8] -> ByteString
packBytes
  toList :: ByteString -> [Item ByteString]
toList   = ByteString -> [Word8]
unpackBytes

-- | Beware: 'fromString' truncates multi-byte characters to octets.
-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�
instance IsString ByteString where
    {-# INLINE fromString #-}
    fromString :: String -> ByteString
fromString = String -> ByteString
packChars

instance Data ByteString where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteString -> c ByteString
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z ByteString
txt = forall g. g -> c g
z [Word8] -> ByteString
packBytes forall d b. Data d => c (d -> b) -> d -> c b
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
  toConstr :: ByteString -> Constr
toConstr ByteString
_     = forall a. (?callStack::CallStack) => String -> a
error String
"Data.ByteString.ByteString.toConstr"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteString
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_    = forall a. (?callStack::CallStack) => String -> a
error String
"Data.ByteString.ByteString.gunfold"
  dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_   = String -> DataType
mkNoRepType String
"Data.ByteString.ByteString"

-- | @since 0.11.2.0
instance TH.Lift ByteString where
#if MIN_VERSION_template_haskell(2,16,0)
  lift :: forall (m :: * -> *). Quote m => ByteString -> m Exp
lift (BS ForeignPtr Word8
ptr Int
len) = [| unsafePackLenLiteral |]
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`TH.appE` forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Integer -> Lit
TH.integerL (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`TH.appE` forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Bytes -> Lit
TH.BytesPrimL forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Word -> Word -> Bytes
TH.Bytes ForeignPtr Word8
ptr Word
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
#else
  lift bs@(BS _ len) = [| unsafePackLenLiteral |]
    `TH.appE` TH.litE (TH.integerL (fromIntegral len))
    `TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)
#endif

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => ByteString -> Code m ByteString
liftTyped = forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

------------------------------------------------------------------------
-- Internal indexing

-- | 'findIndexOrLength' is a variant of findIndex, that returns the length
-- of the string if no element is found, rather than Nothing.
findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength Word8 -> Bool
k (BS ForeignPtr Word8
x Int
l) =
    forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO Int
g ForeignPtr Word8
x
  where
    g :: ForeignPtr Word8 -> IO Int
g ForeignPtr Word8
ptr = Int -> IO Int
go Int
0
      where
        go :: Int -> IO Int
go !Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
l    = forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
              | Bool
otherwise = do Word8
w <- forall a. Storable a => ForeignPtr a -> IO a
peekFp forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
n
                               if Word8 -> Bool
k Word8
w
                                 then forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                                 else Int -> IO Int
go (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE findIndexOrLength #-}

------------------------------------------------------------------------
-- Packing and unpacking from lists

packBytes :: [Word8] -> ByteString
packBytes :: [Word8] -> ByteString
packBytes [Word8]
ws = Int -> [Word8] -> ByteString
unsafePackLenBytes (forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Word8]
ws) [Word8]
ws

packChars :: [Char] -> ByteString
packChars :: String -> ByteString
packChars String
cs = Int -> String -> ByteString
unsafePackLenChars (forall (t :: * -> *) a. Foldable t => t a -> Int
List.length String
cs) String
cs

{-# INLINE [0] packChars #-}

{-# RULES
"ByteString packChars/packAddress" forall s .
   packChars (unpackCString# s) = unsafePackLiteral s
 #-}

unsafePackLenBytes :: Int -> [Word8] -> ByteString
unsafePackLenBytes :: Int -> [Word8] -> ByteString
unsafePackLenBytes Int
len [Word8]
xs0 =
    Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> forall {b}. Storable b => ForeignPtr b -> [b] -> IO ()
go ForeignPtr Word8
p [Word8]
xs0
  where
    go :: ForeignPtr b -> [b] -> IO ()
go !ForeignPtr b
_ []     = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !ForeignPtr b
p (b
x:[b]
xs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p b
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr b -> [b] -> IO ()
go (ForeignPtr b
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) [b]
xs

unsafePackLenChars :: Int -> [Char] -> ByteString
unsafePackLenChars :: Int -> String -> ByteString
unsafePackLenChars Int
len String
cs0 =
    Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> ForeignPtr Word8 -> String -> IO ()
go ForeignPtr Word8
p String
cs0
  where
    go :: ForeignPtr Word8 -> String -> IO ()
go !ForeignPtr Word8
_ []     = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !ForeignPtr Word8
p (Char
c:String
cs) = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p (Char -> Word8
c2w Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> String -> IO ()
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) String
cs


-- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an
-- Addr\# (an arbitrary machine address assumed to point outside the
-- garbage-collected heap) into a @ByteString@. A much faster way to
-- create an 'Addr#' is with an unboxed string literal, than to pack a
-- boxed string. A unboxed string literal is compiled to a static @char
-- []@ by GHC. Establishing the length of the string requires a call to
-- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as
-- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen'
-- if you know the length of the string statically.
--
-- An example:
--
-- > literalFS = unsafePackAddress "literal"#
--
-- This function is /unsafe/. If you modify the buffer pointed to by the
-- original 'Addr#' this modification will be reflected in the resulting
-- @ByteString@, breaking referential transparency.
--
-- Note this also won't work if your 'Addr#' has embedded @\'\\0\'@ characters in
-- the string, as @strlen@ will return too short a length.
--
unsafePackAddress :: Addr# -> IO ByteString
unsafePackAddress :: Addr# -> IO ByteString
unsafePackAddress Addr#
addr# = do
#if __GLASGOW_HASKELL__ >= 811
    Int -> Addr# -> IO ByteString
unsafePackLenAddress (Int# -> Int
I# (Addr# -> Int#
cstringLength# Addr#
addr#)) Addr#
addr#
#else
    l <- c_strlen (Ptr addr#)
    unsafePackLenAddress (fromIntegral l) addr#
#endif
{-# INLINE unsafePackAddress #-}

-- | See 'unsafePackAddress'. This function is similar,
-- but takes an additional length argument rather then computing
-- it with @strlen@.
-- Therefore embedding @\'\\0\'@ characters is possible.
--
-- @since 0.11.2.0
unsafePackLenAddress :: Int -> Addr# -> IO ByteString
unsafePackLenAddress :: Int -> Addr# -> IO ByteString
unsafePackLenAddress Int
len Addr#
addr# = do
#if __GLASGOW_HASKELL__ >= 811
    forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS (forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# ForeignPtrContents
FinalPtr) Int
len)
#else
    p <- newForeignPtr_ (Ptr addr#)
    return $ BS p len
#endif
{-# INLINE unsafePackLenAddress #-}

-- | See 'unsafePackAddress'. This function has similar behavior. Prefer
-- this function when the address in known to be an @Addr#@ literal. In
-- that context, there is no need for the sequencing guarantees that 'IO'
-- provides. On GHC 9.0 and up, this function uses the @FinalPtr@ data
-- constructor for @ForeignPtrContents@.
--
-- @since 0.11.1.0
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral Addr#
addr# =
#if __GLASGOW_HASKELL__ >= 811
  Int -> Addr# -> ByteString
unsafePackLenLiteral (Int# -> Int
I# (Addr# -> Int#
cstringLength# Addr#
addr#)) Addr#
addr#
#else
  let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))
   in unsafePackLenLiteral (fromIntegral len) addr#
#endif
{-# INLINE unsafePackLiteral #-}


-- | See 'unsafePackLiteral'. This function is similar,
-- but takes an additional length argument rather then computing
-- it with @strlen@.
-- Therefore embedding @\'\\0\'@ characters is possible.
--
-- @since 0.11.2.0
unsafePackLenLiteral :: Int -> Addr# -> ByteString
unsafePackLenLiteral :: Int -> Addr# -> ByteString
unsafePackLenLiteral Int
len Addr#
addr# =
#if __GLASGOW_HASKELL__ >= 811
  ForeignPtr Word8 -> Int -> ByteString
BS (forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# ForeignPtrContents
FinalPtr) Int
len
#else
  -- newForeignPtr_ allocates a MutVar# internally. If that MutVar#
  -- gets commoned up with the MutVar# of some unrelated ForeignPtr,
  -- it may prevent automatic finalization for that other ForeignPtr.
  -- So we avoid accursedUnutterablePerformIO here.
  BS (unsafeDupablePerformIO (newForeignPtr_ (Ptr addr#))) len
#endif
{-# INLINE unsafePackLenLiteral #-}

packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes Int
len [Word8]
xs0 =
    forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p0 ->
      let p_end :: ForeignPtr Word8
p_end = forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p0 Int
len
          go :: ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go !ForeignPtr Word8
p []              = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p0, [])
          go !ForeignPtr Word8
p [Word8]
xs | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
p_end = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, [Word8]
xs)
          go !ForeignPtr Word8
p (Word8
x:[Word8]
xs)          = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p Word8
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) [Word8]
xs
      in ForeignPtr Word8 -> [Word8] -> IO (Int, [Word8])
go ForeignPtr Word8
p0 [Word8]
xs0

packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])
packUptoLenChars :: Int -> String -> (ByteString, String)
packUptoLenChars Int
len String
cs0 =
    forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p0 ->
      let p_end :: ForeignPtr Word8
p_end = forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p0 Int
len
          go :: ForeignPtr Word8 -> String -> IO (Int, String)
go !ForeignPtr Word8
p []              = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p0, [])
          go !ForeignPtr Word8
p String
cs | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
p_end = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, String
cs)
          go !ForeignPtr Word8
p (Char
c:String
cs)          = forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p (Char -> Word8
c2w Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> String -> IO (Int, String)
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) String
cs
      in ForeignPtr Word8 -> String -> IO (Int, String)
go ForeignPtr Word8
p0 String
cs0

-- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand
-- we would like to write a tight loop that just blasts the list into memory, on
-- the other hand we want it to be unpacked lazily so we don't end up with a
-- massive list data structure in memory.
--
-- Our strategy is to combine both: we will unpack lazily in reasonable sized
-- chunks, where each chunk is unpacked strictly.
--
-- unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and
-- unpackAppendChars do the chunks strictly.

unpackBytes :: ByteString -> [Word8]
unpackBytes :: ByteString -> [Word8]
unpackBytes ByteString
bs = ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy ByteString
bs []

unpackChars :: ByteString -> [Char]
unpackChars :: ByteString -> String
unpackChars ByteString
bs = ByteString -> ShowS
unpackAppendCharsLazy ByteString
bs []

unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (BS ForeignPtr Word8
fp Int
len) [Word8]
xs
  | Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len) [Word8]
xs
  | Bool
otherwise  = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
100) [Word8]
remainder
  where
    remainder :: [Word8]
remainder  = ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) [Word8]
xs

  -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate
  -- takes just shy of 4k which seems like a reasonable amount.
  -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)

unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]
unpackAppendCharsLazy :: ByteString -> ShowS
unpackAppendCharsLazy (BS ForeignPtr Word8
fp Int
len) String
cs
  | Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len) String
cs
  | Bool
otherwise  = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
100) String
remainder
  where
    remainder :: String
remainder  = ByteString -> ShowS
unpackAppendCharsLazy (ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) String
cs

-- For these unpack functions, since we're unpacking the whole list strictly we
-- build up the result list in an accumulator. This means we have to build up
-- the list starting at the end. So our traversal starts at the end of the
-- buffer and loops down until we hit the sentinal:

unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (BS ForeignPtr Word8
fp Int
len) [Word8]
xs =
    forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
      forall {b}. Storable b => Ptr b -> Ptr b -> [b] -> IO [b]
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1forall a. Num a => a -> a -> a
+Int
len)) [Word8]
xs
  where
    loop :: Ptr b -> Ptr b -> [b] -> IO [b]
loop !Ptr b
sentinal !Ptr b
p [b]
acc
      | Ptr b
p forall a. Eq a => a -> a -> Bool
== Ptr b
sentinal = forall (m :: * -> *) a. Monad m => a -> m a
return [b]
acc
      | Bool
otherwise     = do b
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
                           Ptr b -> Ptr b -> [b] -> IO [b]
loop Ptr b
sentinal (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (b
xforall a. a -> [a] -> [a]
:[b]
acc)

unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]
unpackAppendCharsStrict :: ByteString -> ShowS
unpackAppendCharsStrict (BS ForeignPtr Word8
fp Int
len) String
xs =
    forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
      Ptr Word8 -> Ptr Word8 -> String -> IO String
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1forall a. Num a => a -> a -> a
+Int
len)) String
xs
  where
    loop :: Ptr Word8 -> Ptr Word8 -> String -> IO String
loop !Ptr Word8
sentinal !Ptr Word8
p String
acc
      | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== Ptr Word8
sentinal = forall (m :: * -> *) a. Monad m => a -> m a
return String
acc
      | Bool
otherwise     = do Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
                           Ptr Word8 -> Ptr Word8 -> String -> IO String
loop Ptr Word8
sentinal (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Word8 -> Char
w2c Word8
xforall a. a -> [a] -> [a]
:String
acc)

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

-- | The 0 pointer. Used to indicate the empty Bytestring.
nullForeignPtr :: ForeignPtr Word8
#if __GLASGOW_HASKELL__ >= 811
nullForeignPtr :: ForeignPtr Word8
nullForeignPtr = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# ForeignPtrContents
FinalPtr
#else
nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")
#endif

-- ---------------------------------------------------------------------
-- Low level constructors

-- | /O(1)/ Build a ByteString from a ForeignPtr.
--
-- If you do not need the offset parameter then you should be using
-- 'Data.ByteString.Unsafe.unsafePackCStringLen' or
-- 'Data.ByteString.Unsafe.unsafePackCStringFinalizer' instead.
--
fromForeignPtr :: ForeignPtr Word8
               -> Int -- ^ Offset
               -> Int -- ^ Length
               -> ByteString
fromForeignPtr :: ForeignPtr Word8 -> Int -> Int -> ByteString
fromForeignPtr ForeignPtr Word8
fp Int
o = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o)
{-# INLINE fromForeignPtr #-}

-- | @since 0.11.0.0
fromForeignPtr0 :: ForeignPtr Word8
                -> Int -- ^ Length
                -> ByteString
fromForeignPtr0 :: ForeignPtr Word8 -> Int -> ByteString
fromForeignPtr0 = ForeignPtr Word8 -> Int -> ByteString
BS
{-# INLINE fromForeignPtr0 #-}

-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString
toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -- ^ (ptr, offset, length)
toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (BS ForeignPtr Word8
ps Int
l) = (ForeignPtr Word8
ps, Int
0, Int
l)
{-# INLINE toForeignPtr #-}

-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString
--
-- @since 0.11.0.0
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length)
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 (BS ForeignPtr Word8
ps Int
l) = (ForeignPtr Word8
ps, Int
l)
{-# INLINE toForeignPtr0 #-}

-- | A way of creating ByteStrings outside the IO monad. The @Int@
-- argument gives the final size of the ByteString.
unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l ForeignPtr Word8 -> IO ()
f = forall a. IO a -> a
unsafeDupablePerformIO (Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l ForeignPtr Word8 -> IO ()
f)
{-# INLINE unsafeCreateFp #-}

-- | Like 'unsafeCreateFp' but instead of giving the final size of the
-- ByteString, it is just an upper bound. The inner action returns
-- the actual size. Unlike 'createFpAndTrim' the ByteString is not
-- reallocated if the final size is less than the estimated size.
unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN Int
l ForeignPtr Word8 -> IO Int
f = forall a. IO a -> a
unsafeDupablePerformIO (Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
l ForeignPtr Word8 -> IO Int
f)
{-# INLINE unsafeCreateFpUptoN #-}

unsafeCreateFpUptoN'
  :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
l ForeignPtr Word8 -> IO (Int, a)
f = forall a. IO a -> a
unsafeDupablePerformIO (forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
l ForeignPtr Word8 -> IO (Int, a)
f)
{-# INLINE unsafeCreateFpUptoN' #-}

-- | Create ByteString of size @l@ and use action @f@ to fill its contents.
createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len ForeignPtr Word8 -> IO ()
action = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
    ForeignPtr Word8 -> IO ()
action ForeignPtr Word8
fp
    ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
len
{-# INLINE createFp #-}

-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'
-- starting at the given 'Ptr' and returns the actual utilized length,
-- @`createFpUptoN'` l f@ returns the filled 'ByteString'.
createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
maxLen ForeignPtr Word8 -> IO Int
action = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
maxLen forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
maxLen
    Int
len <- ForeignPtr Word8 -> IO Int
action ForeignPtr Word8
fp
    forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxLen) forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
len
{-# INLINE createFpUptoN #-}

-- | Like 'createFpUptoN', but also returns an additional value created by the
-- action.
createFpUptoN' :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
maxLen ForeignPtr Word8 -> IO (Int, a)
action = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
maxLen forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
maxLen
    (Int
len, a
res) <- ForeignPtr Word8 -> IO (Int, a)
action ForeignPtr Word8
fp
    ByteString
bs <- ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
len
    forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxLen) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
bs, a
res)
{-# INLINE createFpUptoN' #-}

-- | Given the maximum size needed and a function to make the contents
-- of a ByteString, createFpAndTrim makes the 'ByteString'. The generating
-- function is required to return the actual final size (<= the maximum
-- size), and the resulting byte array is reallocated to this size.
--
-- createFpAndTrim is the main mechanism for creating custom, efficient
-- ByteString functions, using Haskell or C functions to fill the space.
--
createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
maxLen ForeignPtr Word8 -> IO Int
action = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
maxLen forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
maxLen
    Int
len <- ForeignPtr Word8 -> IO Int
action ForeignPtr Word8
fp
    if forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxLen) forall a b. (a -> b) -> a -> b
$ Int
len forall a. Ord a => a -> a -> Bool
>= Int
maxLen
        then ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
maxLen
        else Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dest -> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dest ForeignPtr Word8
fp Int
len
{-# INLINE createFpAndTrim #-}

createFpAndTrim' :: Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' :: forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
maxLen ForeignPtr Word8 -> IO (Int, Int, a)
action = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
maxLen forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
maxLen
    (Int
off, Int
len, a
res) <- ForeignPtr Word8 -> IO (Int, Int, a)
action ForeignPtr Word8
fp
    forall a. (?callStack::CallStack) => Bool -> a -> a
assert (
      Int
0 forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxLen Bool -> Bool -> Bool
&& -- length OK
      (Int
len forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
off Bool -> Bool -> Bool
&& Int
off forall a. Ord a => a -> a -> Bool
<= Int
maxLen forall a. Num a => a -> a -> a
- Int
len)) -- offset OK
      ) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ByteString
bs <- if Int
len forall a. Ord a => a -> a -> Bool
>= Int
maxLen
        then ForeignPtr Word8 -> Int -> IO ByteString
mkDeferredByteString ForeignPtr Word8
fp Int
maxLen -- entire buffer used => offset is zero
        else Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dest ->
               ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dest (ForeignPtr Word8
fp forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
off) Int
len
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, a
res)
{-# INLINE createFpAndTrim' #-}


wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction :: forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
  -- Cannot use unsafeWithForeignPtr, because action can diverge

-- | A way of creating ByteStrings outside the IO monad. The @Int@
-- argument gives the final size of the ByteString.
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l Ptr Word8 -> IO ()
f = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO ()
f)
{-# INLINE unsafeCreate #-}

-- | Like 'unsafeCreate' but instead of giving the final size of the
-- ByteString, it is just an upper bound. The inner action returns
-- the actual size. Unlike 'createAndTrim' the ByteString is not
-- reallocated if the final size is less than the estimated size.
unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString
unsafeCreateUptoN Int
l Ptr Word8 -> IO Int
f = Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
unsafeCreateFpUptoN Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
f)
{-# INLINE unsafeCreateUptoN #-}

-- | @since 0.10.12.0
unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' :: forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' Int
l Ptr Word8 -> IO (Int, a)
f = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateFpUptoN' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, a)
f)
{-# INLINE unsafeCreateUptoN' #-}

-- | Create ByteString of size @l@ and use action @f@ to fill its contents.
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l Ptr Word8 -> IO ()
action = Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO ()
action)
{-# INLINE create #-}

-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'
-- starting at the given 'Ptr' and returns the actual utilized length,
-- @`createUptoN'` l f@ returns the filled 'ByteString'.
createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN Int
l Ptr Word8 -> IO Int
action = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpUptoN Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
action)
{-# INLINE createUptoN #-}

-- | Like 'createUptoN', but also returns an additional value created by the
-- action.
--
-- @since 0.10.12.0
createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' :: forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' Int
l Ptr Word8 -> IO (Int, a)
action = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createFpUptoN' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, a)
action)
{-# INLINE createUptoN' #-}

-- | Given the maximum size needed and a function to make the contents
-- of a ByteString, createAndTrim makes the 'ByteString'. The generating
-- function is required to return the actual final size (<= the maximum
-- size), and the resulting byte array is reallocated to this size.
--
-- createAndTrim is the main mechanism for creating custom, efficient
-- ByteString functions, using Haskell or C functions to fill the space.
--
createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
l Ptr Word8 -> IO Int
action = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO Int
action)
{-# INLINE createAndTrim #-}

createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' :: forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' Int
l Ptr Word8 -> IO (Int, Int, a)
action = forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
l (forall res. (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
wrapAction Ptr Word8 -> IO (Int, Int, a)
action)
{-# INLINE createAndTrim' #-}


-- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC
--
mallocByteString :: Int -> IO (ForeignPtr a)
mallocByteString :: forall a. Int -> IO (ForeignPtr a)
mallocByteString = forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes
{-# INLINE mallocByteString #-}

------------------------------------------------------------------------
-- Implementations for Eq, Ord and Monoid instances

eq :: ByteString -> ByteString -> Bool
eq :: ByteString -> ByteString -> Bool
eq a :: ByteString
a@(BS ForeignPtr Word8
fp Int
len) b :: ByteString
b@(BS ForeignPtr Word8
fp' Int
len')
  | Int
len forall a. Eq a => a -> a -> Bool
/= Int
len' = Bool
False    -- short cut on length
  | ForeignPtr Word8
fp forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
fp'   = Bool
True     -- short cut for the same string
  | Bool
otherwise   = ByteString -> ByteString -> Ordering
compareBytes ByteString
a ByteString
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ
{-# INLINE eq #-}
-- ^ still needed

compareBytes :: ByteString -> ByteString -> Ordering
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (BS ForeignPtr Word8
_   Int
0)    (BS ForeignPtr Word8
_   Int
0)    = Ordering
EQ  -- short cut for empty strings
compareBytes (BS ForeignPtr Word8
fp1 Int
len1) (BS ForeignPtr Word8
fp2 Int
len2) =
    forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp1 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp2 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
        CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p1 Ptr Word8
p2 (forall a. Ord a => a -> a -> a
min Int
len1 Int
len2)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case CInt
i forall a. Ord a => a -> a -> Ordering
`compare` CInt
0 of
                    Ordering
EQ  -> Int
len1 forall a. Ord a => a -> a -> Ordering
`compare` Int
len2
                    Ordering
x   -> Ordering
x


-- | /O(1)/ The empty 'ByteString'
empty :: ByteString
-- This enables bypassing #457 by not using (polymorphic) mempty in
-- any definitions used by the (Monoid ByteString) instance
empty :: ByteString
empty = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
nullForeignPtr Int
0

append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append (BS ForeignPtr Word8
_   Int
0)    ByteString
b                  = ByteString
b
append ByteString
a             (BS ForeignPtr Word8
_   Int
0)    = ByteString
a
append (BS ForeignPtr Word8
fp1 Int
len1) (BS ForeignPtr Word8
fp2 Int
len2) =
    Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (String -> Int -> Int -> Int
checkedAdd String
"append" Int
len1 Int
len2) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destptr1 -> do
      let destptr2 :: ForeignPtr Word8
destptr2 = ForeignPtr Word8
destptr1 forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len1
      ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr1 ForeignPtr Word8
fp1 Int
len1
      ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr2 ForeignPtr Word8
fp2 Int
len2

concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat = \[ByteString]
bss0 -> [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
bss0 [ByteString]
bss0
    -- The idea here is we first do a pass over the input list to determine:
    --
    --  1. is a copy necessary? e.g. @concat []@, @concat [mempty, "hello"]@,
    --     and @concat ["hello", mempty, mempty]@ can all be handled without
    --     copying.
    --  2. if a copy is necessary, how large is the result going to be?
    --
    -- If a copy is necessary then we create a buffer of the appropriate size
    -- and do another pass over the input list, copying the chunks into the
    -- buffer. Also, since foreign calls aren't entirely free we skip over
    -- empty chunks while copying.
    --
    -- We pass the original [ByteString] (bss0) through as an argument through
    -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing
    -- it as an explicit argument avoids capturing it in these functions'
    -- closures which would result in unnecessary closure allocation.
  where
    -- It's still possible that the result is empty
    goLen0 :: [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
_    []                     = ByteString
empty
    goLen0 [ByteString]
bss0 (BS ForeignPtr Word8
_ Int
0     :[ByteString]
bss)    = [ByteString] -> [ByteString] -> ByteString
goLen0 [ByteString]
bss0 [ByteString]
bss
    goLen0 [ByteString]
bss0 (ByteString
bs           :[ByteString]
bss)    = [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
bss0 ByteString
bs [ByteString]
bss

    -- It's still possible that the result is a single chunk
    goLen1 :: [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
_    ByteString
bs []                  = ByteString
bs
    goLen1 [ByteString]
bss0 ByteString
bs (BS ForeignPtr Word8
_ Int
0  :[ByteString]
bss)    = [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
bss0 ByteString
bs [ByteString]
bss
    goLen1 [ByteString]
bss0 ByteString
bs (BS ForeignPtr Word8
_ Int
len:[ByteString]
bss)    = [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 (String -> Int -> Int -> Int
checkedAdd String
"concat" Int
len' Int
len) [ByteString]
bss
      where BS ForeignPtr Word8
_ Int
len' = ByteString
bs

    -- General case, just find the total length we'll need
    goLen :: [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 !Int
total (BS ForeignPtr Word8
_ Int
len:[ByteString]
bss) = [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 Int
total' [ByteString]
bss
      where total' :: Int
total' = String -> Int -> Int -> Int
checkedAdd String
"concat" Int
total Int
len
    goLen [ByteString]
bss0 Int
total [] =
      Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
total forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
ptr -> [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss0 ForeignPtr Word8
ptr

    -- Copy the data
    goCopy :: [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy []                  !ForeignPtr Word8
_   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    goCopy (BS ForeignPtr Word8
_  Int
0  :[ByteString]
bss) !ForeignPtr Word8
ptr = [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss ForeignPtr Word8
ptr
    goCopy (BS ForeignPtr Word8
fp Int
len:[ByteString]
bss) !ForeignPtr Word8
ptr = do
      ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
ptr ForeignPtr Word8
fp Int
len
      [ByteString] -> ForeignPtr Word8 -> IO ()
goCopy [ByteString]
bss (ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len)
{-# NOINLINE concat #-}

{-# RULES
"ByteString concat [] -> empty"
   concat [] = empty
"ByteString concat [bs] -> bs" forall x.
   concat [x] = x
 #-}

-- | Repeats the given ByteString n times.
-- Polymorphic wrapper to make sure any generated
-- specializations are reasonably small.
stimesPolymorphic :: Integral a => a -> ByteString -> ByteString
{-# INLINABLE stimesPolymorphic #-}
stimesPolymorphic :: forall b. Integral b => b -> ByteString -> ByteString
stimesPolymorphic a
nRaw !ByteString
bs = case Integer -> Maybe Int
checkedIntegerToInt Integer
n of
  Just Int
nInt
    | Int
nInt forall a. Ord a => a -> a -> Bool
>= Int
0  -> Int -> ByteString -> ByteString
stimesNonNegativeInt Int
nInt ByteString
bs
    | Bool
otherwise  -> ByteString
stimesNegativeErr
  Maybe Int
Nothing
    | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0  -> ByteString
stimesNegativeErr
    | BS ForeignPtr Word8
_ Int
0 <- ByteString
bs  -> ByteString
empty
    | Bool
otherwise     -> ByteString
stimesOverflowErr
  where  n :: Integer
n = forall a. Integral a => a -> Integer
toInteger a
nRaw
  -- By exclusively using n instead of nRaw, the semantics are kept simple
  -- and the likelihood of potentially dangerous mistakes minimized.


stimesNegativeErr :: ByteString
stimesNegativeErr :: ByteString
stimesNegativeErr
  = forall a. (?callStack::CallStack) => String -> a
error String
"stimes @ByteString: non-negative multiplier expected"

stimesOverflowErr :: ByteString
-- Although this only appears once, it is extracted here to prevent it
-- from being duplicated in specializations of 'stimesPolymorphic'
stimesOverflowErr :: ByteString
stimesOverflowErr = forall a. String -> a
overflowError String
"stimes"

-- | Repeats the given ByteString n times.
stimesNonNegativeInt :: Int -> ByteString -> ByteString
stimesNonNegativeInt :: Int -> ByteString -> ByteString
stimesNonNegativeInt Int
n (BS ForeignPtr Word8
fp Int
len)
  | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
empty
  | Int
n forall a. Eq a => a -> a -> Bool
== Int
1 = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len
  | Int
len forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
empty
  | Int
len forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
n forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destfptr -> do
      Word8
byte <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
fp
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
destfptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr ->
        forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Word8
destptr Word8
byte Int
n
  | Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
size forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destptr -> do
      ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destptr ForeignPtr Word8
fp Int
len
      ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr Int
len
  where
    size :: Int
size = String -> Int -> Int -> Int
checkedMultiply String
"stimes" Int
n Int
len
    halfSize :: Int
halfSize = (Int
size forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
2 -- subtraction and division won't overflow

    fillFrom :: ForeignPtr Word8 -> Int -> IO ()
    fillFrom :: ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr Int
copied
      | Int
copied forall a. Ord a => a -> a -> Bool
<= Int
halfSize = do
        ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
destptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
copied) ForeignPtr Word8
destptr Int
copied
        ForeignPtr Word8 -> Int -> IO ()
fillFrom ForeignPtr Word8
destptr (Int
copied forall a. Num a => a -> a -> a
* Int
2)
      | Bool
otherwise = ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
destptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
copied) ForeignPtr Word8
destptr (Int
size forall a. Num a => a -> a -> a
- Int
copied)


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

-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.
w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2c #-}

-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and
-- silently truncates to 8 bits Chars > '\255'. It is provided as
-- convenience for ByteString construction.
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}

-- | Selects words corresponding to white-space characters in the Latin-1 range
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 Word8
w8 =
    -- Avoid the cost of narrowing arithmetic results to Word8,
    -- the conversion from Word8 to Word is free.
    let w :: Word
        !w :: Word
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
     in Word
w forall a. Bits a => a -> a -> a
.&. Word
0x50 forall a. Eq a => a -> a -> Bool
== Word
0    -- Quick non-whitespace filter
        Bool -> Bool -> Bool
&& Word
w forall a. Num a => a -> a -> a
- Word
0x21 forall a. Ord a => a -> a -> Bool
> Word
0x7e -- Second non-whitespace filter
        Bool -> Bool -> Bool
&& ( Word
w forall a. Eq a => a -> a -> Bool
== Word
0x20     -- SP
          Bool -> Bool -> Bool
|| Word
w forall a. Eq a => a -> a -> Bool
== Word
0xa0     -- NBSP
          Bool -> Bool -> Bool
|| Word
w forall a. Num a => a -> a -> a
- Word
0x09 forall a. Ord a => a -> a -> Bool
< Word
5) -- HT, NL, VT, FF, CR
{-# INLINE isSpaceWord8 #-}

-- | Selects white-space characters in the Latin-1 range
isSpaceChar8 :: Char -> Bool
isSpaceChar8 :: Char -> Bool
isSpaceChar8 = Word8 -> Bool
isSpaceWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE isSpaceChar8 #-}

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

-- | The type of exception raised by 'overflowError'
-- and on failure by overflow-checked arithmetic operations.
newtype SizeOverflowException
  = SizeOverflowException String

instance Show SizeOverflowException where
  show :: SizeOverflowException -> String
show (SizeOverflowException String
err) = String
err

instance Exception SizeOverflowException

-- | Raises a 'SizeOverflowException',
-- with a message using the given function name.
overflowError :: String -> a
overflowError :: forall a. String -> a
overflowError String
fun = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> SizeOverflowException
SizeOverflowException String
msg
  where msg :: String
msg = String
"Data.ByteString." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": size overflow"

-- | Add two non-negative numbers.
-- Calls 'overflowError' on overflow.
checkedAdd :: String -> Int -> Int -> Int
{-# INLINE checkedAdd #-}
checkedAdd :: String -> Int -> Int -> Int
checkedAdd String
fun Int
x Int
y
  -- checking "r < 0" here matches the condition in mallocPlainForeignPtrBytes,
  -- helping the compiler see the latter is redundant in some places
  | Int
r forall a. Ord a => a -> a -> Bool
< Int
0     = forall a. String -> a
overflowError String
fun
  | Bool
otherwise = Int
r
  where r :: Int
r = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Ord a => a -> a -> a
min Int
x Int
y forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ Int
x forall a. Num a => a -> a -> a
+ Int
y

-- | Multiplies two non-negative numbers.
-- Calls 'overflowError' on overflow.
checkedMultiply :: String -> Int -> Int -> Int
{-# INLINE checkedMultiply #-}
checkedMultiply :: String -> Int -> Int -> Int
checkedMultiply String
fun !x :: Int
x@(I# Int#
x#) !y :: Int
y@(I# Int#
y#) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Ord a => a -> a -> a
min Int
x Int
y forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$
#if TIMES_INT_2_AVAILABLE
  case Int# -> Int# -> (# Int#, Int#, Int# #)
timesInt2# Int#
x# Int#
y# of
    (# Int#
0#, Int#
_, Int#
result #) -> Int# -> Int
I# Int#
result
    (# Int#, Int#, Int# #)
_ -> forall a. String -> a
overflowError String
fun
#else
  case timesWord2# (int2Word# x#) (int2Word# y#) of
    (# hi, lo #) -> case or# hi (uncheckedShiftRL# lo shiftAmt) of
      0## -> I# (word2Int# lo)
      _   -> overflowError fun
  where !(I# shiftAmt) = finiteBitSize (0 :: Word) - 1
#endif


-- | Attempts to convert an 'Integer' value to an 'Int', returning
-- 'Nothing' if doing so would result in an overflow.
checkedIntegerToInt :: Integer -> Maybe Int
{-# INLINE checkedIntegerToInt #-}
-- We could use Data.Bits.toIntegralSized, but this hand-rolled
-- version is currently a bit faster as of GHC 9.2.
-- It's even faster to just match on the Integer constructors, but
-- we'd still need a fallback implementation for integer-simple.
checkedIntegerToInt :: Integer -> Maybe Int
checkedIntegerToInt Integer
x
  | Integer
x forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger Int
res = forall a. a -> Maybe a
Just Int
res
  | Bool
otherwise = forall a. Maybe a
Nothing
  where  res :: Int
res = forall a. Num a => Integer -> a
fromInteger Integer
x :: Int


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

-- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but
-- it is in fact a malevolent agent of chaos. It unpicks the seams of reality
-- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you
-- into thinking it is reasonable, but when you are not looking it stabs you
-- in the back and aliases all of your mutable buffers. The carcass of many a
-- seasoned Haskell programmer lie strewn at its feet.
--
-- Witness the trail of destruction:
--
-- * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>
--
-- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>
--
-- * <https://github.com/haskell/aeson/commit/720b857e2e0acf2edc4f5512f2b217a89449a89d>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/3486>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/3487>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/7270>
--
-- * <https://gitlab.haskell.org/ghc/ghc/-/issues/22204>
--
-- Do not talk about \"safe\"! You do not know what is safe!
--
-- Yield not to its blasphemous call! Flee traveller! Flee or you will be
-- corrupted and devoured!
--
{-# INLINE accursedUnutterablePerformIO #-}
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO :: forall a. IO a -> a
accursedUnutterablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r

-- ---------------------------------------------------------------------
--
-- Standard C functions
--

foreign import ccall unsafe "string.h strlen" c_strlen
    :: CString -> IO CSize

foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer
    :: FunPtr (Ptr Word8 -> IO ())

foreign import ccall unsafe "string.h memchr" c_memchr
    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)

memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
w CSize
sz = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) CSize
sz

foreign import ccall unsafe "string.h memcmp" c_memcmp
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt

memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p Ptr Word8
q Int
s = Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
c_memcmp Ptr Word8
p Ptr Word8
q (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)

{-# DEPRECATED memcpy "Use Foreign.Marshal.Utils.copyBytes instead" #-}
-- | deprecated since @bytestring-0.11.5.0@
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy = forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes

memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
fp ForeignPtr Word8
fq Int
s = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
                     forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fq forall a b. (a -> b) -> a -> b
$ \Ptr Word8
q -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p Ptr Word8
q Int
s

foreign import ccall unsafe "string.h memset" c_memset
    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)

{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}
-- | deprecated since @bytestring-0.11.5.0@
memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset Ptr Word8
p Word8
w CSize
sz = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memset Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) CSize
sz

-- ---------------------------------------------------------------------
--
-- Uses our C code
--

foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()

foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse
    :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()

foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum
    :: Ptr Word8 -> CSize -> IO Word8

foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum
    :: Ptr Word8 -> CSize -> IO Word8

foreign import ccall unsafe "static fpstring.h fps_count" c_count
    :: Ptr Word8 -> CSize -> Word8 -> IO CSize

foreign import ccall unsafe "static fpstring.h fps_sort" c_sort
    :: Ptr Word8 -> CSize -> IO ()