{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
{-# LANGUAGE UnliftedFFITypes, MagicHash,
            UnboxedTuples, DeriveDataTypeable #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
#endif
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Unsafe #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.ByteString.Internal
-- 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
--
-- A module containing semi-public 'ByteString' internals. This exposes the
-- 'ByteString' representation and low level construction functions. As such
-- all the functions in this module are unsafe. The API is also not stable.
--
-- Where possible application should instead use the functions from the normal
-- public interface modules, such as "Data.ByteString.Unsafe". Packages that
-- extend the ByteString system at a low level will need to use this module.
--
module Data.ByteString.Internal (

        -- * The @ByteString@ type and representation
        ByteString
        ( BS
#if __GLASGOW_HASKELL__ >= 800
        , PS -- backwards compatibility shim
#endif
        ), -- instances: Eq, Ord, Show, Read, Data, Typeable

        -- * Internal indexing
        findIndexOrLength,

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

        -- * Low level imperative construction
        create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
        createUptoN,            -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
        createUptoN',           -- :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
        createAndTrim,          -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
        createAndTrim',         -- :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
        unsafeCreate,           -- :: Int -> (Ptr Word8 -> IO ()) -> ByteString
        unsafeCreateUptoN,      -- :: Int -> (Ptr Word8 -> IO Int) -> ByteString
        unsafeCreateUptoN',     -- :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
        mallocByteString,       -- :: Int -> IO (ForeignPtr a)

        -- * Conversion to and from ForeignPtrs
        fromForeignPtr,         -- :: ForeignPtr Word8 -> Int -> Int -> ByteString
        toForeignPtr,           -- :: ByteString -> (ForeignPtr Word8, Int, Int)
        fromForeignPtr0,        -- :: ForeignPtr Word8 -> Int -> ByteString
        toForeignPtr0,          -- :: ByteString -> (ForeignPtr Word8, Int)

        -- * Utilities
        nullForeignPtr,         -- :: ForeignPtr Word8
        checkedAdd,             -- :: String -> Int -> Int -> Int

        -- * Standard C Functions
        c_strlen,               -- :: CString -> IO CInt
        c_free_finalizer,       -- :: FunPtr (Ptr Word8 -> IO ())

        memchr,                 -- :: Ptr Word8 -> Word8 -> CSize -> IO Ptr Word8
        memcmp,                 -- :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
        memcpy,                 -- :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
        memset,                 -- :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)

        -- * cbits functions
        c_reverse,              -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
        c_intersperse,          -- :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()
        c_maximum,              -- :: Ptr Word8 -> CSize -> IO Word8
        c_minimum,              -- :: Ptr Word8 -> CSize -> IO Word8
        c_count,                -- :: Ptr Word8 -> CSize -> Word8 -> IO CSize
        c_sort,                 -- :: Ptr Word8 -> CSize -> IO ()

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

        -- * Deprecated and unmentionable
        accursedUnutterablePerformIO, -- :: IO a -> a

        -- * Exported compatibility shim
        plusForeignPtr,
        unsafeWithForeignPtr
  ) where

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

import Control.Monad            (void)

import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)
import Foreign.Ptr              (Ptr, FunPtr, plusPtr, minusPtr)
import Foreign.Storable         (Storable(..))

#if MIN_VERSION_base(4,5,0) || __GLASGOW_HASKELL__ >= 703
import Foreign.C.Types          (CInt(..), CSize(..))
#else
import Foreign.C.Types          (CInt, CSize)
#endif

import Foreign.C.String         (CString)

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

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid              (Monoid(..))
#endif


import Control.DeepSeq          (NFData(rnf))

import Data.String              (IsString(..))

import Control.Exception        (assert)

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

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

import GHC.Base                 (nullAddr#,realWorld#,unsafeChr)

#if MIN_VERSION_base(4,7,0)
import GHC.Exts                 (IsList(..))
#endif

#if MIN_VERSION_base(4,4,0)
import GHC.CString              (unpackCString#)
#else
import GHC.Base                 (unpackCString#)
#endif

import GHC.Prim                 (Addr#)

import GHC.IO                   (IO(IO),unsafeDupablePerformIO)

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(..), castPtr)
#endif

#if (__GLASGOW_HASKELL__ < 802) || (__GLASGOW_HASKELL__ >= 811)
import GHC.Types                (Int (..))
#endif

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

#if !MIN_VERSION_base(4,15,0)
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
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

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

-- | 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
    deriving (Typeable)


#if __GLASGOW_HASKELL__ >= 800
-- |
-- @'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) -> (Void# -> 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 (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o) Int
len
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE PS #-}
#endif
#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

#if MIN_VERSION_base(4,9,0)
instance Semigroup ByteString where
    <> :: ByteString -> ByteString -> ByteString
(<>)    = ByteString -> ByteString -> ByteString
append
    sconcat :: NonEmpty ByteString -> ByteString
sconcat (ByteString
b:|[ByteString]
bs) = [ByteString] -> ByteString
concat (ByteString
bByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bs)
    stimes :: b -> ByteString -> ByteString
stimes = b -> ByteString -> ByteString
forall b. Integral b => b -> ByteString -> ByteString
times
#endif

instance Monoid ByteString where
    mempty :: ByteString
mempty  = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
nullForeignPtr Int
0
#if MIN_VERSION_base(4,9,0)
    mappend :: ByteString -> ByteString -> ByteString
mappend = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>)
#else
    mappend = append
#endif
    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 = Int -> String -> ShowS
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) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]

#if MIN_VERSION_base(4,7,0)
-- | @since 0.10.12.0
instance IsList ByteString where
  type Item ByteString = Word8
  fromList :: [Item ByteString] -> ByteString
fromList = [Word8] -> ByteString
[Item ByteString] -> ByteString
packBytes
  toList :: ByteString -> [Item ByteString]
toList   = ByteString -> [Word8]
ByteString -> [Item ByteString]
unpackBytes
#endif

-- | 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 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 = ([Word8] -> ByteString) -> c ([Word8] -> ByteString)
forall g. g -> c g
z [Word8] -> ByteString
packBytes c ([Word8] -> ByteString) -> [Word8] -> c ByteString
forall d b. Data d => c (d -> b) -> d -> c b
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
  toConstr :: ByteString -> Constr
toConstr ByteString
_     = String -> Constr
forall a. HasCallStack => String -> a
error String
"Data.ByteString.ByteString.toConstr"
  gunfold :: (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
_    = String -> Constr -> c ByteString
forall a. HasCallStack => String -> a
error String
"Data.ByteString.ByteString.gunfold"
  dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_   = String -> DataType
mkNoRepType String
"Data.ByteString.ByteString"

------------------------------------------------------------------------
-- 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) =
    IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x Ptr Word8 -> IO Int
g
  where
    g :: Ptr Word8 -> IO Int
g Ptr Word8
ptr = Int -> IO Int
go Int
0
      where
        go :: Int -> IO Int
go !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l    = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
              | Bool
otherwise = do Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> IO Word8) -> Ptr Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
                               if Word8 -> Bool
k Word8
w
                                 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                                 else Int -> IO Int
go (Int
nInt -> Int -> Int
forall 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 ([Word8] -> Int
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 (String -> Int
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 -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> [Word8] -> IO ()
forall b. Storable b => Ptr b -> [b] -> IO ()
go Ptr Word8
p [Word8]
xs0
  where
    go :: Ptr b -> [b] -> IO ()
go !Ptr b
_ []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !Ptr b
p (b
x:[b]
xs) = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
p b
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> [b] -> IO ()
go (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) [b]
xs

unsafePackLenChars :: Int -> [Char] -> ByteString
unsafePackLenChars :: Int -> String -> ByteString
unsafePackLenChars Int
len String
cs0 =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> String -> IO ()
go Ptr Word8
p String
cs0
  where
    go :: Ptr Word8 -> String -> IO ()
go !Ptr Word8
_ []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !Ptr Word8
p (Char
c:String
cs) = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Char -> Word8
c2w Char
c) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> String -> IO ()
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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
    return (BS (ForeignPtr addr# FinalPtr) (I# (cstringLength# addr#)))
#else
    ForeignPtr Word8
p <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr)
    CSize
l <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
cstr
    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 -> ByteString
BS ForeignPtr Word8
p (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
l)
  where
    cstr :: CString
    cstr :: Ptr CChar
cstr = Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
addr#
#endif
{-# INLINE unsafePackAddress #-}

-- | 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@.
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral :: Addr# -> ByteString
unsafePackLiteral Addr#
addr# =
#if __GLASGOW_HASKELL__ >= 811
  BS (ForeignPtr addr# FinalPtr) (I# (cstringLength# addr#))
#else
  let len :: CSize
len = IO CSize -> CSize
forall a. IO a -> a
accursedUnutterablePerformIO (Ptr CChar -> IO CSize
c_strlen (Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
addr#))
   in ForeignPtr Word8 -> Int -> ByteString
BS (IO (ForeignPtr Word8) -> ForeignPtr Word8
forall a. IO a -> a
accursedUnutterablePerformIO (Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#))) (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
#endif
{-# INLINE unsafePackLiteral #-}


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

packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])
packUptoLenChars :: Int -> String -> (ByteString, String)
packUptoLenChars Int
len String
cs0 =
    Int -> (Ptr Word8 -> IO (Int, String)) -> (ByteString, String)
forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' Int
len ((Ptr Word8 -> IO (Int, String)) -> (ByteString, String))
-> (Ptr Word8 -> IO (Int, String)) -> (ByteString, String)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 ->
      let p_end :: Ptr Word8
p_end = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p0 Int
len
          go :: Ptr Word8 -> String -> IO (Int, String)
go !Ptr Word8
p []              = (Int, String) -> IO (Int, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p0, [])
          go !Ptr Word8
p String
cs | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
p_end = (Int, String) -> IO (Int, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, String
cs)
          go !Ptr Word8
p (Char
c:String
cs)          = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Char -> Word8
c2w Char
c) IO () -> IO (Int, String) -> IO (Int, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> String -> IO (Int, String)
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) String
cs
      in Ptr Word8 -> String -> IO (Int, String)
go Ptr 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 Int -> Int -> Bool
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 (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenInt -> Int -> Int
forall 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 Int -> Int -> Bool
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 (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
100) (Int
lenInt -> Int -> Int
forall 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 =
    IO [Word8] -> [Word8]
forall a. IO a -> a
accursedUnutterablePerformIO (IO [Word8] -> [Word8]) -> IO [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO [Word8]) -> IO [Word8])
-> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
      Ptr Word8 -> Ptr Word8 -> [Word8] -> IO [Word8]
forall b. Storable b => Ptr b -> Ptr b -> [b] -> IO [b]
loop (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1Int -> Int -> Int
forall 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 Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
sentinal = [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
acc
      | Bool
otherwise     = do b
x <- Ptr b -> IO b
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 Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (b
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
acc)

unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]
unpackAppendCharsStrict :: ByteString -> ShowS
unpackAppendCharsStrict (BS ForeignPtr Word8
fp Int
len) String
xs =
    IO String -> String
forall a. IO a -> a
accursedUnutterablePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO String) -> IO String)
-> (Ptr Word8 -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
      Ptr Word8 -> Ptr Word8 -> String -> IO String
loop (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1Int -> Int -> Int
forall 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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
sentinal = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
acc
      | Bool
otherwise     = do Word8
x <- Ptr Word8 -> IO Word8
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Word8 -> Char
w2c Word8
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc)

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

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

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

-- | /O(1)/ Build a ByteString from a ForeignPtr.
--
-- If you do not need the offset parameter then you do 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 (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
o)
{-# INLINE fromForeignPtr #-}

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
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.
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l Ptr Word8 -> IO ()
f = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l 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 = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createUptoN Int
l Ptr Word8 -> IO Int
f)
{-# INLINE unsafeCreateUptoN #-}

-- | @since 0.10.12.0
unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)
unsafeCreateUptoN' Int
l Ptr Word8 -> IO (Int, a)
f = IO (ByteString, a) -> (ByteString, a)
forall a. IO a -> a
unsafeDupablePerformIO (Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
forall a. Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' Int
l 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 ()
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO ()
f Ptr Word8
p
    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 -> ByteString
BS ForeignPtr Word8
fp Int
l
{-# 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
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    Int
l' <- 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 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO Int
f Ptr Word8
p
    Bool -> IO ByteString -> IO ByteString
forall a. HasCallStack => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l) (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ 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 -> ByteString
BS ForeignPtr Word8
fp Int
l'
{-# 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' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)
createUptoN' Int
l Ptr Word8 -> IO (Int, a)
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    (Int
l', a
res) <- ForeignPtr Word8 -> (Ptr Word8 -> IO (Int, a)) -> IO (Int, a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (Int, a)) -> IO (Int, a))
-> (Ptr Word8 -> IO (Int, a)) -> IO (Int, a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO (Int, a)
f Ptr Word8
p
    Bool -> IO (ByteString, a) -> IO (ByteString, a)
forall a. HasCallStack => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l) (IO (ByteString, a) -> IO (ByteString, a))
-> IO (ByteString, a) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$ (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
l', a
res)
{-# 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 realloced 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
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        Int
l' <- Ptr Word8 -> IO Int
f Ptr Word8
p
        if Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
            then 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 -> ByteString
BS ForeignPtr Word8
fp Int
l
            else Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l' ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p' -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p' Ptr Word8
p Int
l'
{-# INLINE createAndTrim #-}

createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' Int
l Ptr Word8 -> IO (Int, Int, a)
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, a)) -> IO (ByteString, a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (ByteString, a)) -> IO (ByteString, a))
-> (Ptr Word8 -> IO (ByteString, a)) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        (Int
off, Int
l', a
res) <- Ptr Word8 -> IO (Int, Int, a)
f Ptr Word8
p
        if Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
            then (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
l, a
res)
            else do ByteString
ps <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l' ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p' ->
                            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Int
l'
                    (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ps, a
res)

-- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC
--
mallocByteString :: Int -> IO (ForeignPtr a)
mallocByteString :: Int -> IO (ForeignPtr a)
mallocByteString = Int -> IO (ForeignPtr a)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len' = Bool
False    -- short cut on length
  | ForeignPtr Word8
fp ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
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 Ordering -> Ordering -> Bool
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) =
    IO Ordering -> Ordering
forall a. IO a -> a
accursedUnutterablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr Word8 -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp1 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp2 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
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 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len1 Int
len2)
        Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$! case CInt
i CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CInt
0 of
                    Ordering
EQ  -> Int
len1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
len2
                    Ordering
x   -> Ordering
x

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 -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
len1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len2) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr1 -> do
      let destptr2 :: Ptr Word8
destptr2 = Ptr Word8
destptr1 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp1 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
destptr1 Ptr Word8
p1 Int
len1
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp2 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
destptr2 Ptr Word8
p2 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
forall a. Monoid a => a
mempty
    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 -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
total ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> [ByteString] -> Ptr Word8 -> IO ()
goCopy [ByteString]
bss0 Ptr Word8
ptr

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

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

#if MIN_VERSION_base(4,9,0)
-- | /O(log n)/ Repeats the given ByteString n times.
times :: Integral a => a -> ByteString -> ByteString
times :: a -> ByteString -> ByteString
times a
n (BS ForeignPtr Word8
fp Int
len)
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = String -> ByteString
forall a. HasCallStack => String -> a
error String
"stimes: non-negative multiplier expected"
  | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = ByteString
forall a. Monoid a => a
mempty
  | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
forall a. Monoid a => a
mempty
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
size ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
      Word8
byte <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
      IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset Ptr Word8
destptr Word8
byte (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
  | Bool
otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
size ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
destptr Ptr Word8
p Int
len
      Ptr Word8 -> Int -> IO ()
fillFrom Ptr Word8
destptr Int
len
  where
    size :: Int
size = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n

    fillFrom :: Ptr Word8 -> Int -> IO ()
    fillFrom :: Ptr Word8 -> Int -> IO ()
fillFrom Ptr Word8
destptr Int
copied
      | Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
copied Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size = do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Word8
destptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
copied) Ptr Word8
destptr Int
copied
        Ptr Word8 -> Int -> IO ()
fillFrom Ptr Word8
destptr (Int
copied Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
      | Bool
otherwise = Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Word8
destptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
copied) Ptr Word8
destptr (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
copied)
#endif

-- | Add two non-negative numbers. Errors out on overflow.
checkedAdd :: String -> Int -> Int -> Int
checkedAdd :: String -> Int -> Int -> Int
checkedAdd String
fun Int
x Int
y
  | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = Int
r
  | Bool
otherwise = String -> Int
forall a. String -> a
overflowError String
fun
  where r :: Int
r = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y
{-# INLINE checkedAdd #-}

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

-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.
w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
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 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
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 = Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
     in Word
w Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x50 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0    -- Quick non-whitespace filter
        Bool -> Bool -> Bool
&& Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0x21 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0x7e -- Second non-whitespace filter
        Bool -> Bool -> Bool
&& ( Word
w Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0x20     -- SP
          Bool -> Bool -> Bool
|| Word
w Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0xa0     -- NBSP
          Bool -> Bool -> Bool
|| Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0x09 Word -> Word -> Bool
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 (Word8 -> Bool) -> (Char -> Word8) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE isSpaceChar8 #-}

overflowError :: String -> a
overflowError :: String -> a
overflowError String
fun = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.ByteString." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": size overflow"

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

-- | 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://ghc.haskell.org/trac/ghc/ticket/3486>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/3487>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/7270>
--
-- 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 :: 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 = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p (Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)

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 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)

foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p Ptr Word8
q Int
s = IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
p Ptr Word8
q (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)

{-
foreign import ccall unsafe "string.h memmove" c_memmove
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
memmove p q s = do c_memmove p q s
                   return ()
-}

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

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

-- ---------------------------------------------------------------------
--
-- 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 ()