{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
{-# LANGUAGE UnliftedFFITypes, MagicHash,
            UnboxedTuples, DeriveDataTypeable #-}
#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(..),         -- instances: Eq, Ord, Show, Read, Data, Typeable

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

        -- * Low level imperative construction
        create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
        createUptoN,            -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString
        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
        mallocByteString,       -- :: Int -> IO (ForeignPtr a)

        -- * Conversion to and from ForeignPtrs
        fromForeignPtr,         -- :: ForeignPtr Word8 -> Int -> Int -> ByteString
        toForeignPtr,           -- :: ByteString -> (ForeignPtr Word8, Int, 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 -> CInt -> IO ()
        c_intersperse,          -- :: Ptr Word8 -> Ptr Word8 -> CInt -> Word8 -> IO ()
        c_maximum,              -- :: Ptr Word8 -> CInt -> IO Word8
        c_minimum,              -- :: Ptr Word8 -> CInt -> IO Word8
        c_count,                -- :: Ptr Word8 -> CInt -> Word8 -> IO CInt

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

        -- * Deprecated and unmentionable
        accursedUnutterablePerformIO, -- :: IO a -> a
        inlinePerformIO               -- :: IO a -> a
  ) 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(..))

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

import Foreign.C.String         (CString)

#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup           (Semigroup((<>)))
#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.Char                (ord)
import Data.Word                (Word8)

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

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

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

import GHC.Prim                 (Addr#)

#if __GLASGOW_HASKELL__ >= 611
import GHC.IO                   (IO(IO),unsafeDupablePerformIO)
#else
import GHC.IOBase               (IO(IO),RawBuffer,unsafeDupablePerformIO)
#endif

import GHC.ForeignPtr           (ForeignPtr(ForeignPtr)
                                ,newForeignPtr_, mallocPlainForeignPtrBytes)
import GHC.Ptr                  (Ptr(..), castPtr)

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

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

-- | 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 = PS {-# UNPACK #-} !(ForeignPtr Word8) -- payload
                     {-# UNPACK #-} !Int                -- offset
                     {-# UNPACK #-} !Int                -- length
    deriving (Typeable)

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
#endif

instance Monoid ByteString where
    mempty :: ByteString
mempty  = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
nullForeignPtr Int
0 Int
0
#if MIN_VERSION_base(4,9,0)
    mappend :: ByteString -> ByteString -> ByteString
mappend = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup ByteString
(<>)
#else
    mappend = append
#endif
    mconcat :: [ByteString] -> ByteString
mconcat = [ByteString] -> ByteString
concat

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

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
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
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
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
readsPrec Int
p String
str ]

instance IsString ByteString where
    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
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Word8
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
  toConstr :: ByteString -> Constr
toConstr ByteString
_     = String -> Constr
forall a. (?callStack::CallStack) => 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. (?callStack::CallStack) => String -> a
error String
"Data.ByteString.ByteString.gunfold"
  dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_   = String -> DataType
mkNoRepType String
"Data.ByteString.ByteString"

------------------------------------------------------------------------
-- 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
External instance of the constraint type Foldable []
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
External instance of the constraint type Foldable []
List.length String
cs) String
cs

{-# INLINE [0] packChars #-}

{-# RULES
"ByteString packChars/packAddress" forall s .
   packChars (unpackCString# s) = accursedUnutterablePerformIO (unsafePackAddress 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 ()
External instance of the constraint type Storable Word8
go Ptr Word8
p [Word8]
xs0
  where
    go :: Ptr b -> [b] -> IO ()
go !Ptr b
_ []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()
    go !Ptr b
p (b
x:[b]
xs) = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Evidence bound by a type signature of the constraint type Storable b
poke Ptr b
p b
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> 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
External instance of the constraint type Monad IO
return ()
    go !Ptr Word8
p (Char
c:String
cs) = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
External instance of the constraint type Storable Word8
poke Ptr Word8
p (Char -> Word8
c2w Char
c) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> 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 '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
    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
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
p Int
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CSize
fromIntegral CSize
l)
  where
    cstr :: CString
    cstr :: Ptr CChar
cstr = Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
addr#
{-# INLINE unsafePackAddress #-}


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
p -> Ptr Word8 -> Int -> [Word8] -> IO (Int, [Word8])
forall {b}. Storable b => Ptr b -> Int -> [b] -> IO (Int, [b])
External instance of the constraint type Storable Word8
go Ptr Word8
p Int
len [Word8]
xs0
  where
    go :: Ptr b -> Int -> [b] -> IO (Int, [b])
go !Ptr b
_ !Int
n []     = (Int, [b]) -> IO (Int, [b])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
n, [])
    go !Ptr b
_ !Int
0 [b]
xs     = (Int, [b]) -> IO (Int, [b])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Int
len,   [b]
xs)
    go !Ptr b
p !Int
n (b
x:[b]
xs) = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Evidence bound by a type signature of the constraint type Storable b
poke Ptr b
p b
x IO () -> IO (Int, [b]) -> IO (Int, [b])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> Ptr b -> Int -> [b] -> IO (Int, [b])
go (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) [b]
xs

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
p -> Ptr Word8 -> Int -> String -> IO (Int, String)
go Ptr Word8
p Int
len String
cs0
  where
    go :: Ptr Word8 -> Int -> String -> IO (Int, String)
go !Ptr Word8
_ !Int
n []     = (Int, String) -> IO (Int, String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
n, [])
    go !Ptr Word8
_ !Int
0 String
cs     = (Int, String) -> IO (Int, String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Int
len,   String
cs)
    go !Ptr Word8
p !Int
n (Char
c:String
cs) = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
External instance of the constraint type Storable Word8
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
External instance of the constraint type Monad IO
>> Ptr Word8 -> Int -> String -> IO (Int, String)
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) String
cs

-- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand
-- we would like to write a tight loop that just blats 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 (PS ForeignPtr Word8
fp Int
off Int
len) [Word8]
xs
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
100 = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
len) [Word8]
xs
  | Bool
otherwise  = ByteString -> [Word8] -> [Word8]
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
100) [Word8]
remainder
  where
    remainder :: [Word8]
remainder  = ByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
100) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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 (PS ForeignPtr Word8
fp Int
off Int
len) String
cs
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
100 = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
len) String
cs
  | Bool
otherwise  = ByteString -> ShowS
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
100) String
remainder
  where
    remainder :: String
remainder  = ByteString -> ShowS
unpackAppendCharsLazy (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
100) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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 (PS ForeignPtr Word8
fp Int
off 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
withForeignPtr 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]
External instance of the constraint type Storable Word8
loop (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1)) (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+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
External instance of the constraint type forall a. Eq (Ptr a)
== Ptr b
sentinal = [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [b]
acc
      | Bool
otherwise     = do b
x <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
Evidence bound by a type signature of the constraint type Storable b
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 (PS ForeignPtr Word8
fp Int
off 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
withForeignPtr 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
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1)) (Ptr Word8
base Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+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
External instance of the constraint type forall a. Eq (Ptr a)
== Ptr Word8
sentinal = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return String
acc
      | Bool
otherwise     = do Word8
x <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
External instance of the constraint type Storable Word8
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
nullForeignPtr :: ForeignPtr Word8
nullForeignPtr = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# (String -> ForeignPtrContents
forall a. (?callStack::CallStack) => String -> a
error String
"nullForeignPtr") --TODO: should ForeignPtrContents be strict?

-- ---------------------------------------------------------------------
-- 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 -> Int -> Int -> ByteString
PS
{-# INLINE fromForeignPtr #-}

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

-- | 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 #-}

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 it's 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
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
l
{-# INLINE create #-}

-- | Create ByteString of up to size size @l@ and use action @f@ to fill it's
-- contents which returns its true size.
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. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
l'
{-# INLINE createUptoN #-}

-- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.
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. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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
External instance of the constraint type Monad IO
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 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. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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
External instance of the constraint type Ord Int
>= Int
l
            then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 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. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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
External instance of the constraint type Ord Int
>= Int
l
            then (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 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
External instance of the constraint type Monad IO
return (ByteString
ps, a
res)

-- | Wrapper of '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@(PS ForeignPtr Word8
fp Int
off Int
len) b :: ByteString
b@(PS ForeignPtr Word8
fp' Int
off' Int
len')
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
/= Int
len'              = Bool
False    -- short cut on length
  | ForeignPtr Word8
fp ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq (ForeignPtr a)
== ForeignPtr Word8
fp' Bool -> Bool -> Bool
&& Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
off' = 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
External instance of the constraint type Eq Ordering
== Ordering
EQ
{-# INLINE eq #-}
-- ^ still needed

compareBytes :: ByteString -> ByteString -> Ordering
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (PS ForeignPtr Word8
_   Int
_    Int
0)    (PS ForeignPtr Word8
_   Int
_    Int
0)    = Ordering
EQ  -- short cut for empty strings
compareBytes (PS ForeignPtr Word8
fp1 Int
off1 Int
len1) (PS ForeignPtr Word8
fp2 Int
off2 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
withForeignPtr 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
withForeignPtr 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 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off1) (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off2) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
External instance of the constraint type Ord Int
min Int
len1 Int
len2)
        Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Ord CInt
`compare` CInt
0 of
                    Ordering
EQ  -> Int
len1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Int
`compare` Int
len2
                    Ordering
x   -> Ordering
x

append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append (PS ForeignPtr Word8
_   Int
_    Int
0)    ByteString
b                  = ByteString
b
append ByteString
a                  (PS ForeignPtr Word8
_   Int
_    Int
0)    = ByteString
a
append (PS ForeignPtr Word8
fp1 Int
off1 Int
len1) (PS ForeignPtr Word8
fp2 Int
off2 Int
len2) =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
len1Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
len2) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destptr1 -> do
      let destptr2 :: Ptr b
destptr2 = Ptr Word8
destptr1 Ptr Word8 -> Int -> Ptr b
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
withForeignPtr 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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off1) Int
len1
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr 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
forall {b}. Ptr b
destptr2 (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off2) 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
Instance of class: Monoid of the constraint type Monoid ByteString
mempty
    goLen0 [ByteString]
bss0 (PS ForeignPtr Word8
_ Int
_ 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 (PS ForeignPtr Word8
_ Int
_ Int
0  :[ByteString]
bss)    = [ByteString] -> ByteString -> [ByteString] -> ByteString
goLen1 [ByteString]
bss0 ByteString
bs [ByteString]
bss
    goLen1 [ByteString]
bss0 ByteString
bs (PS ForeignPtr Word8
_ Int
_ 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 PS ForeignPtr Word8
_ Int
_ Int
len' = ByteString
bs

    -- General case, just find the total length we'll need
    goLen :: [ByteString] -> Int -> [ByteString] -> ByteString
goLen [ByteString]
bss0 !Int
total (PS ForeignPtr Word8
_ Int
_ 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
External instance of the constraint type Monad IO
return ()
    goCopy (PS ForeignPtr Word8
_  Int
_   Int
0  :[ByteString]
bss) !Ptr Word8
ptr = [ByteString] -> Ptr Word8 -> IO ()
goCopy [ByteString]
bss Ptr Word8
ptr
    goCopy (PS ForeignPtr Word8
fp Int
off 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
withForeignPtr 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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) 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
 #-}

-- | 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
External instance of the constraint type Ord Int
>= 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
External instance of the constraint type Num Int
+ 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
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
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
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
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
-- ordered by frequency.
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 :: Word8 -> Bool
isSpaceWord8 Word8
w =
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x20 Bool -> Bool -> Bool
||
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x0A Bool -> Bool -> Bool
|| -- LF, \n
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x09 Bool -> Bool -> Bool
|| -- HT, \t
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x0C Bool -> Bool -> Bool
|| -- FF, \f
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x0D Bool -> Bool -> Bool
|| -- CR, \r
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0x0B Bool -> Bool -> Bool
|| -- VT, \v
    Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Word8
== Word8
0xA0    -- spotted by QC..
{-# INLINE isSpaceWord8 #-}

-- | Selects white-space characters in the Latin-1 range
isSpaceChar8 :: Char -> Bool
isSpaceChar8 :: Char -> Bool
isSpaceChar8 Char
c =
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
' '     Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\t'    Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\n'    Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\r'    Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\f'    Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\v'    Bool -> Bool -> Bool
||
    Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\xa0'
{-# INLINE isSpaceChar8 #-}

overflowError :: String -> a
overflowError :: String -> a
overflowError String
fun = String -> a
forall a. (?callStack::CallStack) => 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 '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

inlinePerformIO :: IO a -> a
inlinePerformIO :: IO a -> a
inlinePerformIO = IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO
{-# INLINE inlinePerformIO #-}
{-# DEPRECATED inlinePerformIO "If you think you know what you are doing, use 'unsafePerformIO'. If you are sure you know what you are doing, use 'unsafeDupablePerformIO'. If you enjoy sharing an address space with a malevolent agent of chaos, try 'accursedUnutterablePerformIO'." #-}

-- ---------------------------------------------------------------------
--
-- 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
s = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p (Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num CInt
External instance of the constraint type Integral Word8
fromIntegral Word8
w) CSize
s

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
External instance of the constraint type Num CSize
External instance of the constraint type Integral Int
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 = 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
External instance of the constraint type Num CSize
External instance of the constraint type Integral Int
fromIntegral Int
s) IO (Ptr Word8) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()

{-
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 CSize
s = Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
c_memset Ptr Word8
p (Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num CInt
External instance of the constraint type Integral Word8
fromIntegral Word8
w) CSize
s

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

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

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

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

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

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