{-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes,
             ForeignFunctionInterface, MagicHash, UnboxedTuples,
             UnliftedFFITypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.ByteString.Short.Internal
-- Copyright   : (c) Duncan Coutts 2012-2013
-- License     : BSD-style
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : stable
-- Portability : ghc only
--
-- Internal representation of ShortByteString
--
module Data.ByteString.Short.Internal (

    -- * The @ShortByteString@ type and representation
    ShortByteString(..),

    -- * Conversions
    toShort,
    fromShort,
    pack,
    unpack,

    -- * Other operations
    empty, null, length, index, indexMaybe, (!?), unsafeIndex,

    -- * Low level operations
    createFromPtr, copyToPtr,

    -- * Low level conversions
    -- ** Packing 'CString's and pointers
    packCString,
    packCStringLen,

    -- ** Using ByteStrings as 'CString's
    useAsCString,
    useAsCStringLen
  ) where

import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)
import qualified Data.ByteString.Internal as BS

import Data.Typeable    (Typeable)
import Data.Data        (Data(..), mkNoRepType)
import Data.Semigroup   (Semigroup((<>)))
import Data.Monoid      (Monoid(..))
import Data.String      (IsString(..))
import Control.DeepSeq  (NFData(..))
import qualified Data.List as List (length)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types  (CSize(..), CInt(..))
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.Storable (pokeByteOff)

import qualified GHC.Exts
import GHC.Exts ( Int(I#), Int#, Ptr(Ptr), Addr#, Char(C#)
                , State#, RealWorld
                , ByteArray#, MutableByteArray#
                , newByteArray#
                , newPinnedByteArray#
                , byteArrayContents#
                , unsafeCoerce#
#if MIN_VERSION_base(4,10,0)
                , isByteArrayPinned#
                , isTrue#
#endif
                , sizeofByteArray#
                , indexWord8Array#, indexCharArray#
                , writeWord8Array#, writeCharArray#
                , unsafeFreezeByteArray# )
import GHC.IO
import GHC.ForeignPtr (ForeignPtr(ForeignPtr), ForeignPtrContents(PlainPtr))
import GHC.ST         (ST(ST), runST)
import GHC.Stack.Types (HasCallStack)
import GHC.Word

import Prelude ( Eq(..), Ord(..), Ordering(..), Read(..), Show(..)
               , ($), ($!), error, (++), (.)
               , String, userError
               , Bool(..), (&&), otherwise
               , (+), (-), fromIntegral
               , return
               , Maybe(..) )

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

-- | A compact representation of a 'Word8' vector.
--
-- It has a lower memory overhead than a 'ByteString' and does not
-- contribute to heap fragmentation. It can be converted to or from a
-- 'ByteString' (at the cost of copying the string data). It supports very few
-- other operations.
--
-- It is suitable for use as an internal representation for code that needs
-- to keep many short strings in memory, but it /should not/ be used as an
-- interchange type. That is, it should not generally be used in public APIs.
-- The 'ByteString' type is usually more suitable for use in interfaces; it is
-- more flexible and it supports a wide range of operations.
--
data ShortByteString = SBS ByteArray#
    deriving Typeable

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

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: ShortByteString -> Q (TExp ShortByteString)
liftTyped = Q Exp -> Q (TExp ShortByteString)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp ShortByteString))
-> (ShortByteString -> Q Exp)
-> ShortByteString
-> Q (TExp ShortByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- The ByteArray# representation is always word sized and aligned but with a
-- known byte length. Our representation choice for ShortByteString is to leave
-- the 0--3 trailing bytes undefined. This means we can use word-sized writes,
-- but we have to be careful with reads, see equateBytes and compareBytes below.


instance Eq ShortByteString where
    == :: ShortByteString -> ShortByteString -> Bool
(==)    = ShortByteString -> ShortByteString -> Bool
equateBytes

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

instance Semigroup ShortByteString where
    <> :: ShortByteString -> ShortByteString -> ShortByteString
(<>)    = ShortByteString -> ShortByteString -> ShortByteString
append

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

instance NFData ShortByteString where
    rnf :: ShortByteString -> ()
rnf SBS{} = ()

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

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

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

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

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

------------------------------------------------------------------------
-- Simple operations

-- | /O(1)/. The empty 'ShortByteString'.
empty :: ShortByteString
empty :: ShortByteString
empty = Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
0 (\MBA s
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | /O(1)/ The length of a 'ShortByteString'.
length :: ShortByteString -> Int
length :: ShortByteString -> Int
length (SBS ByteArray#
barr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
barr#)

-- | /O(1)/ Test whether a 'ShortByteString' is empty.
null :: ShortByteString -> Bool
null :: ShortByteString -> Bool
null ShortByteString
sbs = ShortByteString -> Int
length ShortByteString
sbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.
index :: HasCallStack => ShortByteString -> Int -> Word8
index :: ShortByteString -> Int -> Word8
index ShortByteString
sbs Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ShortByteString -> Int
length ShortByteString
sbs = ShortByteString -> Int -> Word8
unsafeIndex ShortByteString
sbs Int
i
  | Bool
otherwise                = ShortByteString -> Int -> Word8
forall a. HasCallStack => ShortByteString -> Int -> a
indexError ShortByteString
sbs Int
i

-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
--
-- > 0 <= n < length bs
--
-- @since 0.11.0.0
indexMaybe :: ShortByteString -> Int -> Maybe Word8
indexMaybe :: ShortByteString -> Int -> Maybe Word8
indexMaybe ShortByteString
sbs Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ShortByteString -> Int
length ShortByteString
sbs = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! ShortByteString -> Int -> Word8
unsafeIndex ShortByteString
sbs Int
i
  | Bool
otherwise                = Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE indexMaybe #-}

-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
--
-- > 0 <= n < length bs
--
-- @since 0.11.0.0
(!?) :: ShortByteString -> Int -> Maybe Word8
!? :: ShortByteString -> Int -> Maybe Word8
(!?) = ShortByteString -> Int -> Maybe Word8
indexMaybe
{-# INLINE (!?) #-}

unsafeIndex :: ShortByteString -> Int -> Word8
unsafeIndex :: ShortByteString -> Int -> Word8
unsafeIndex ShortByteString
sbs = BA -> Int -> Word8
indexWord8Array (ShortByteString -> BA
asBA ShortByteString
sbs)

indexError :: HasCallStack => ShortByteString -> Int -> a
indexError :: ShortByteString -> Int -> a
indexError ShortByteString
sbs Int
i =
  String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.ByteString.Short.index: error in array index; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not in range [0.." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ShortByteString -> Int
length ShortByteString
sbs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | @since 0.11.2.0
unsafePackLenLiteral :: Int -> Addr# -> ShortByteString
unsafePackLenLiteral :: Int -> Addr# -> ShortByteString
unsafePackLenLiteral Int
len Addr#
addr# =
    IO ShortByteString -> ShortByteString
forall a. IO a -> a
accursedUnutterablePerformIO (IO ShortByteString -> ShortByteString)
-> IO ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Ptr Any -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
createFromPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len

------------------------------------------------------------------------
-- Internal utils

asBA :: ShortByteString -> BA
asBA :: ShortByteString -> BA
asBA (SBS ByteArray#
ba#) = ByteArray# -> BA
BA# ByteArray#
ba#

create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
len forall s. MBA s -> ST s ()
fill =
    (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
      MBA s
mba <- Int -> ST s (MBA s)
forall s. Int -> ST s (MBA s)
newByteArray Int
len
      MBA s -> ST s ()
forall s. MBA s -> ST s ()
fill MBA s
mba
      BA# ByteArray#
ba# <- MBA s -> ST s BA
forall s. MBA s -> ST s BA
unsafeFreezeByteArray MBA s
mba
      ShortByteString -> ST s ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)
{-# INLINE create #-}

------------------------------------------------------------------------
-- Conversion to and from ByteString

-- | /O(n)/. Convert a 'ByteString' into a 'ShortByteString'.
--
-- This makes a copy, so does not retain the input string.
--
toShort :: ByteString -> ShortByteString
toShort :: ByteString -> ShortByteString
toShort !ByteString
bs = IO ShortByteString -> ShortByteString
forall a. IO a -> a
unsafeDupablePerformIO (ByteString -> IO ShortByteString
toShortIO ByteString
bs)

toShortIO :: ByteString -> IO ShortByteString
toShortIO :: ByteString -> IO ShortByteString
toShortIO (BS ForeignPtr Word8
fptr Int
len) = do
    MBA RealWorld
mba <- ST RealWorld (MBA RealWorld) -> IO (MBA RealWorld)
forall a. ST RealWorld a -> IO a
stToIO (Int -> ST RealWorld (MBA RealWorld)
forall s. Int -> ST s (MBA s)
newByteArray Int
len)
    let ptr :: Ptr Word8
ptr = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
    ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (Ptr Word8 -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
forall a. Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray Ptr Word8
ptr MBA RealWorld
mba Int
0 Int
len)
    ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fptr
    BA# ByteArray#
ba# <- ST RealWorld BA -> IO BA
forall a. ST RealWorld a -> IO a
stToIO (MBA RealWorld -> ST RealWorld BA
forall s. MBA s -> ST s BA
unsafeFreezeByteArray MBA RealWorld
mba)
    ShortByteString -> IO ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)


-- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'.
--
fromShort :: ShortByteString -> ByteString
#if MIN_VERSION_base(4,10,0)
fromShort :: ShortByteString -> ByteString
fromShort (SBS ByteArray#
b#)
  | Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
b#) = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len
  where
    addr# :: Addr#
addr# = ByteArray# -> Addr#
byteArrayContents# ByteArray#
b#
    fp :: ForeignPtr Word8
fp = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
unsafeCoerce# ByteArray#
b#))
    len :: Int
len = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
b#)
#endif
fromShort !ShortByteString
sbs = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (ShortByteString -> IO ByteString
fromShortIO ShortByteString
sbs)

fromShortIO :: ShortByteString -> IO ByteString
fromShortIO :: ShortByteString -> IO ByteString
fromShortIO ShortByteString
sbs = do
    let len :: Int
len = ShortByteString -> Int
length ShortByteString
sbs
    mba :: MBA RealWorld
mba@(MBA# MutableByteArray# RealWorld
mba#) <- ST RealWorld (MBA RealWorld) -> IO (MBA RealWorld)
forall a. ST RealWorld a -> IO a
stToIO (Int -> ST RealWorld (MBA RealWorld)
forall s. Int -> ST s (MBA s)
newPinnedByteArray Int
len)
    ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (BA -> Int -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
forall s. BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (ShortByteString -> BA
asBA ShortByteString
sbs) Int
0 MBA RealWorld
mba Int
0 Int
len)
    let fp :: ForeignPtr Word8
fp = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
unsafeCoerce# MutableByteArray# RealWorld
mba#))
                        (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr MutableByteArray# RealWorld
mba#)
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len)


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

-- | /O(n)/. Convert a list into a 'ShortByteString'
pack :: [Word8] -> ShortByteString
pack :: [Word8] -> ShortByteString
pack = [Word8] -> ShortByteString
packBytes

-- | /O(n)/. Convert a 'ShortByteString' into a list.
unpack :: ShortByteString -> [Word8]
unpack :: ShortByteString -> [Word8]
unpack = ShortByteString -> [Word8]
unpackBytes

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

packBytes :: [Word8] -> ShortByteString
packBytes :: [Word8] -> ShortByteString
packBytes [Word8]
cs = Int -> [Word8] -> ShortByteString
packLenBytes ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Word8]
cs) [Word8]
cs

packLenChars :: Int -> [Char] -> ShortByteString
packLenChars :: Int -> String -> ShortByteString
packLenChars Int
len String
cs0 =
    Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
len (\MBA s
mba -> MBA s -> Int -> String -> ST s ()
forall s. MBA s -> Int -> String -> ST s ()
go MBA s
mba Int
0 String
cs0)
  where
    go :: MBA s -> Int -> [Char] -> ST s ()
    go :: MBA s -> Int -> String -> ST s ()
go !MBA s
_   !Int
_ []     = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !MBA s
mba !Int
i (Char
c:String
cs) = do
      MBA s -> Int -> Char -> ST s ()
forall s. MBA s -> Int -> Char -> ST s ()
writeCharArray MBA s
mba Int
i Char
c
      MBA s -> Int -> String -> ST s ()
forall s. MBA s -> Int -> String -> ST s ()
go MBA s
mba (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
cs

packLenBytes :: Int -> [Word8] -> ShortByteString
packLenBytes :: Int -> [Word8] -> ShortByteString
packLenBytes Int
len [Word8]
ws0 =
    Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create Int
len (\MBA s
mba -> MBA s -> Int -> [Word8] -> ST s ()
forall s. MBA s -> Int -> [Word8] -> ST s ()
go MBA s
mba Int
0 [Word8]
ws0)
  where
    go :: MBA s -> Int -> [Word8] -> ST s ()
    go :: MBA s -> Int -> [Word8] -> ST s ()
go !MBA s
_   !Int
_ []     = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !MBA s
mba !Int
i (Word8
w:[Word8]
ws) = do
      MBA s -> Int -> Word8 -> ST s ()
forall s. MBA s -> Int -> Word8 -> ST s ()
writeWord8Array MBA s
mba Int
i Word8
w
      MBA s -> Int -> [Word8] -> ST s ()
forall s. MBA s -> Int -> [Word8] -> ST s ()
go MBA s
mba (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Word8]
ws

-- 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.
--
-- unpackChars does the lazy loop, while unpackAppendBytes and
-- unpackAppendChars do the chunks strictly.

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

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

-- 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 :: ShortByteString -> [Char] -> [Char]
unpackAppendCharsLazy :: ShortByteString -> ShowS
unpackAppendCharsLazy ShortByteString
sbs = Int -> Int -> ShowS
go Int
0 (ShortByteString -> Int
length ShortByteString
sbs)
  where
    sz :: Int
sz = Int
100

    go :: Int -> Int -> ShowS
go Int
off Int
len String
cs
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sz = ShortByteString -> Int -> Int -> ShowS
unpackAppendCharsStrict ShortByteString
sbs Int
off Int
len String
cs
      | Bool
otherwise = ShortByteString -> Int -> Int -> ShowS
unpackAppendCharsStrict ShortByteString
sbs Int
off Int
sz  String
remainder
                      where remainder :: String
remainder = Int -> Int -> ShowS
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sz) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sz) String
cs

unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]
unpackAppendBytesLazy ShortByteString
sbs = Int -> Int -> [Word8] -> [Word8]
go Int
0 (ShortByteString -> Int
length ShortByteString
sbs)
  where
    sz :: Int
sz = Int
100

    go :: Int -> Int -> [Word8] -> [Word8]
go Int
off Int
len [Word8]
ws
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sz = ShortByteString -> Int -> Int -> [Word8] -> [Word8]
unpackAppendBytesStrict ShortByteString
sbs Int
off Int
len [Word8]
ws
      | Bool
otherwise = ShortByteString -> Int -> Int -> [Word8] -> [Word8]
unpackAppendBytesStrict ShortByteString
sbs Int
off Int
sz  [Word8]
remainder
                      where remainder :: [Word8]
remainder = Int -> Int -> [Word8] -> [Word8]
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sz) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sz) [Word8]
ws

-- 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:

unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]
unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> ShowS
unpackAppendCharsStrict !ShortByteString
sbs Int
off Int
len = Int -> Int -> ShowS
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  where
    go :: Int -> Int -> ShowS
go !Int
sentinal !Int
i !String
acc
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sentinal = String
acc
      | Bool
otherwise     = let !c :: Char
c = BA -> Int -> Char
indexCharArray (ShortByteString -> BA
asBA ShortByteString
sbs) Int
i
                        in Int -> Int -> ShowS
go Int
sentinal (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc)

unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]
unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]
unpackAppendBytesStrict !ShortByteString
sbs Int
off Int
len = Int -> Int -> [Word8] -> [Word8]
go (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  where
    go :: Int -> Int -> [Word8] -> [Word8]
go !Int
sentinal !Int
i ![Word8]
acc
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sentinal = [Word8]
acc
      | Bool
otherwise     = let !w :: Word8
w = BA -> Int -> Word8
indexWord8Array (ShortByteString -> BA
asBA ShortByteString
sbs) Int
i
                         in Int -> Int -> [Word8] -> [Word8]
go Int
sentinal (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word8
wWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
acc)


------------------------------------------------------------------------
-- Eq and Ord implementations

equateBytes :: ShortByteString -> ShortByteString -> Bool
equateBytes :: ShortByteString -> ShortByteString -> Bool
equateBytes ShortByteString
sbs1 ShortByteString
sbs2 =
    let !len1 :: Int
len1 = ShortByteString -> Int
length ShortByteString
sbs1
        !len2 :: Int
len2 = ShortByteString -> Int
length ShortByteString
sbs2
     in Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len2
     Bool -> Bool -> Bool
&& CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== IO CInt -> CInt
forall a. IO a -> a
accursedUnutterablePerformIO
               (BA -> BA -> Int -> IO CInt
memcmp_ByteArray (ShortByteString -> BA
asBA ShortByteString
sbs1) (ShortByteString -> BA
asBA ShortByteString
sbs2) Int
len1)

compareBytes :: ShortByteString -> ShortByteString -> Ordering
compareBytes :: ShortByteString -> ShortByteString -> Ordering
compareBytes ShortByteString
sbs1 ShortByteString
sbs2 =
    let !len1 :: Int
len1 = ShortByteString -> Int
length ShortByteString
sbs1
        !len2 :: Int
len2 = ShortByteString -> Int
length ShortByteString
sbs2
        !len :: Int
len  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len1 Int
len2
     in case IO CInt -> CInt
forall a. IO a -> a
accursedUnutterablePerformIO
               (BA -> BA -> Int -> IO CInt
memcmp_ByteArray (ShortByteString -> BA
asBA ShortByteString
sbs1) (ShortByteString -> BA
asBA ShortByteString
sbs2) Int
len) of
          CInt
i | CInt
i    CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0    -> Ordering
LT
            | CInt
i    CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0    -> Ordering
GT
            | Int
len2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len1 -> Ordering
LT
            | Int
len2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len1 -> Ordering
GT
            | Bool
otherwise   -> Ordering
EQ


------------------------------------------------------------------------
-- Appending and concatenation

append :: ShortByteString -> ShortByteString -> ShortByteString
append :: ShortByteString -> ShortByteString -> ShortByteString
append ShortByteString
src1 ShortByteString
src2 =
  let !len1 :: Int
len1 = ShortByteString -> Int
length ShortByteString
src1
      !len2 :: Int
len2 = ShortByteString -> Int
length ShortByteString
src2
   in Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2) ((forall s. MBA s -> ST s ()) -> ShortByteString)
-> (forall s. MBA s -> ST s ()) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ \MBA s
dst -> do
        BA -> Int -> MBA s -> Int -> Int -> ST s ()
forall s. BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (ShortByteString -> BA
asBA ShortByteString
src1) Int
0 MBA s
dst Int
0    Int
len1
        BA -> Int -> MBA s -> Int -> Int -> ST s ()
forall s. BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (ShortByteString -> BA
asBA ShortByteString
src2) Int
0 MBA s
dst Int
len1 Int
len2

concat :: [ShortByteString] -> ShortByteString
concat :: [ShortByteString] -> ShortByteString
concat [ShortByteString]
sbss =
    Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
create (Int -> [ShortByteString] -> Int
totalLen Int
0 [ShortByteString]
sbss) (\MBA s
dst -> MBA s -> Int -> [ShortByteString] -> ST s ()
forall s. MBA s -> Int -> [ShortByteString] -> ST s ()
copy MBA s
dst Int
0 [ShortByteString]
sbss)
  where
    totalLen :: Int -> [ShortByteString] -> Int
totalLen !Int
acc []          = Int
acc
    totalLen !Int
acc (ShortByteString
sbs: [ShortByteString]
sbss) = Int -> [ShortByteString] -> Int
totalLen (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
length ShortByteString
sbs) [ShortByteString]
sbss

    copy :: MBA s -> Int -> [ShortByteString] -> ST s ()
    copy :: MBA s -> Int -> [ShortByteString] -> ST s ()
copy !MBA s
_   !Int
_   []                           = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    copy !MBA s
dst !Int
off (ShortByteString
src : [ShortByteString]
sbss) = do
      let !len :: Int
len = ShortByteString -> Int
length ShortByteString
src
      BA -> Int -> MBA s -> Int -> Int -> ST s ()
forall s. BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (ShortByteString -> BA
asBA ShortByteString
src) Int
0 MBA s
dst Int
off Int
len
      MBA s -> Int -> [ShortByteString] -> ST s ()
forall s. MBA s -> Int -> [ShortByteString] -> ST s ()
copy MBA s
dst (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) [ShortByteString]
sbss


------------------------------------------------------------------------
-- Exported low level operations

copyToPtr :: ShortByteString  -- ^ source data
          -> Int              -- ^ offset into source
          -> Ptr a            -- ^ destination
          -> Int              -- ^ number of bytes to copy
          -> IO ()
copyToPtr :: ShortByteString -> Int -> Ptr a -> Int -> IO ()
copyToPtr ShortByteString
src Int
off Ptr a
dst Int
len =
    ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$
      BA -> Int -> Ptr a -> Int -> ST RealWorld ()
forall a. BA -> Int -> Ptr a -> Int -> ST RealWorld ()
copyByteArrayToAddr (ShortByteString -> BA
asBA ShortByteString
src) Int
off Ptr a
dst Int
len

createFromPtr :: Ptr a   -- ^ source data
              -> Int     -- ^ number of bytes to copy
              -> IO ShortByteString
createFromPtr :: Ptr a -> Int -> IO ShortByteString
createFromPtr !Ptr a
ptr Int
len =
    ST RealWorld ShortByteString -> IO ShortByteString
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld ShortByteString -> IO ShortByteString)
-> ST RealWorld ShortByteString -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ do
      MBA RealWorld
mba <- Int -> ST RealWorld (MBA RealWorld)
forall s. Int -> ST s (MBA s)
newByteArray Int
len
      Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
forall a. Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray Ptr a
ptr MBA RealWorld
mba Int
0 Int
len
      BA# ByteArray#
ba# <- MBA RealWorld -> ST RealWorld BA
forall s. MBA s -> ST s BA
unsafeFreezeByteArray MBA RealWorld
mba
      ShortByteString -> ST RealWorld ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)


------------------------------------------------------------------------
-- Primop wrappers

data BA    = BA# ByteArray#
data MBA s = MBA# (MutableByteArray# s)

indexCharArray :: BA -> Int -> Char
indexCharArray :: BA -> Int -> Char
indexCharArray (BA# ByteArray#
ba#) (I# Int#
i#) = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexCharArray# ByteArray#
ba# Int#
i#)

indexWord8Array :: BA -> Int -> Word8
indexWord8Array :: BA -> Int -> Word8
indexWord8Array (BA# ByteArray#
ba#) (I# Int#
i#) = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba# Int#
i#)

newByteArray :: Int -> ST s (MBA s)
newByteArray :: Int -> ST s (MBA s)
newByteArray (I# Int#
len#) =
    STRep s (MBA s) -> ST s (MBA s)
forall s a. STRep s a -> ST s a
ST (STRep s (MBA s) -> ST s (MBA s))
-> STRep s (MBA s) -> ST s (MBA s)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len# State# s
s of
                 (# State# s
s, MutableByteArray# s
mba# #) -> (# State# s
s, MutableByteArray# s -> MBA s
forall s. MutableByteArray# s -> MBA s
MBA# MutableByteArray# s
mba# #)

newPinnedByteArray :: Int -> ST s (MBA s)
newPinnedByteArray :: Int -> ST s (MBA s)
newPinnedByteArray (I# Int#
len#) =
    STRep s (MBA s) -> ST s (MBA s)
forall s a. STRep s a -> ST s a
ST (STRep s (MBA s) -> ST s (MBA s))
-> STRep s (MBA s) -> ST s (MBA s)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
len# State# s
s of
                 (# State# s
s, MutableByteArray# s
mba# #) -> (# State# s
s, MutableByteArray# s -> MBA s
forall s. MutableByteArray# s -> MBA s
MBA# MutableByteArray# s
mba# #)

unsafeFreezeByteArray :: MBA s -> ST s BA
unsafeFreezeByteArray :: MBA s -> ST s BA
unsafeFreezeByteArray (MBA# MutableByteArray# s
mba#) =
    STRep s BA -> ST s BA
forall s a. STRep s a -> ST s a
ST (STRep s BA -> ST s BA) -> STRep s BA -> ST s BA
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba# State# s
s of
                 (# State# s
s, ByteArray#
ba# #) -> (# State# s
s, ByteArray# -> BA
BA# ByteArray#
ba# #)

writeCharArray :: MBA s -> Int -> Char -> ST s ()
writeCharArray :: MBA s -> Int -> Char -> ST s ()
writeCharArray (MBA# MutableByteArray# s
mba#) (I# Int#
i#) (C# Char#
c#) =
  STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeCharArray# MutableByteArray# s
mba# Int#
i# Char#
c# State# s
s of
               State# s
s -> (# State# s
s, () #)

writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()
writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()
writeWord8Array (MBA# MutableByteArray# s
mba#) (I# Int#
i#) (W8# Word#
w#) =
  STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# Int#
i# Word#
w# State# s
s of
               State# s
s -> (# State# s
s, () #)

copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
copyAddrToByteArray (Ptr Addr#
src#) (MBA# MutableByteArray# RealWorld
dst#) (I# Int#
dst_off#) (I# Int#
len#) =
    STRep RealWorld () -> ST RealWorld ()
forall s a. STRep s a -> ST s a
ST (STRep RealWorld () -> ST RealWorld ())
-> STRep RealWorld () -> ST RealWorld ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
copyAddrToByteArray# Addr#
src# MutableByteArray# RealWorld
dst# Int#
dst_off# Int#
len# State# RealWorld
s of
                 State# RealWorld
s -> (# State# RealWorld
s, () #)

copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld ()
copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld ()
copyByteArrayToAddr (BA# ByteArray#
src#) (I# Int#
src_off#) (Ptr Addr#
dst#) (I# Int#
len#) =
    STRep RealWorld () -> ST RealWorld ()
forall s a. STRep s a -> ST s a
ST (STRep RealWorld () -> ST RealWorld ())
-> STRep RealWorld () -> ST RealWorld ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
copyByteArrayToAddr# ByteArray#
src# Int#
src_off# Addr#
dst# Int#
len# State# RealWorld
s of
                 State# RealWorld
s -> (# State# RealWorld
s, () #)

copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
copyByteArray (BA# ByteArray#
src#) (I# Int#
src_off#) (MBA# MutableByteArray# s
dst#) (I# Int#
dst_off#) (I# Int#
len#) =
    STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyByteArray# ByteArray#
src# Int#
src_off# MutableByteArray# s
dst# Int#
dst_off# Int#
len# State# s
s of
                 State# s
s -> (# State# s
s, () #)


------------------------------------------------------------------------
-- FFI imports

memcmp_ByteArray :: BA -> BA -> Int -> IO CInt
memcmp_ByteArray :: BA -> BA -> Int -> IO CInt
memcmp_ByteArray (BA# ByteArray#
ba1#) (BA# ByteArray#
ba2#) Int
len =
  ByteArray# -> ByteArray# -> CSize -> IO CInt
c_memcmp_ByteArray ByteArray#
ba1# ByteArray#
ba2# (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

foreign import ccall unsafe "string.h memcmp"
  c_memcmp_ByteArray :: ByteArray# -> ByteArray# -> CSize -> IO CInt


------------------------------------------------------------------------
-- Primop replacements

copyAddrToByteArray# :: Addr#
                     -> MutableByteArray# RealWorld -> Int#
                     -> Int#
                     -> State# RealWorld -> State# RealWorld

copyByteArrayToAddr# :: ByteArray# -> Int#
                     -> Addr#
                     -> Int#
                     -> State# RealWorld -> State# RealWorld

copyByteArray#       :: ByteArray# -> Int#
                     -> MutableByteArray# s -> Int#
                     -> Int#
                     -> State# s -> State# s

copyAddrToByteArray# :: Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
copyAddrToByteArray# = Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
GHC.Exts.copyAddrToByteArray#
copyByteArrayToAddr# :: ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
copyByteArrayToAddr# = ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
GHC.Exts.copyByteArrayToAddr#
copyByteArray# :: ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyByteArray# = ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
GHC.Exts.copyByteArray#

-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The
-- resulting @ShortByteString@ is an immutable copy of the original
-- @CString@, and is managed on the Haskell heap. The original
-- @CString@ must be null terminated.
--
-- @since 0.10.10.0
packCString :: CString -> IO ShortByteString
packCString :: CString -> IO ShortByteString
packCString CString
cstr = do
  CSize
len <- CString -> IO CSize
BS.c_strlen CString
cstr
  CStringLen -> IO ShortByteString
packCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The
-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.
-- The @ShortByteString@ is a normal Haskell value and will be managed on the
-- Haskell heap.
--
-- @since 0.10.10.0
packCStringLen :: CStringLen -> IO ShortByteString
packCStringLen :: CStringLen -> IO ShortByteString
packCStringLen (CString
cstr, Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = CString -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
createFromPtr CString
cstr Int
len
packCStringLen (CString
_, Int
len) =
  String -> String -> IO ShortByteString
forall a. HasCallStack => String -> String -> IO a
moduleErrorIO String
"packCStringLen" (String
"negative length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len)

-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a
-- null-terminated @CString@.  The @CString@ is a copy and will be freed
-- automatically; it must not be stored or used after the
-- subcomputation finishes.
--
-- @since 0.10.10.0
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString ShortByteString
bs CString -> IO a
action =
  Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
      ShortByteString -> Int -> CString -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
copyToPtr ShortByteString
bs Int
0 CString
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
      CString -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff CString
buf Int
l (Word8
0::Word8)
      CString -> IO a
action CString
buf
  where l :: Int
l = ShortByteString -> Int
length ShortByteString
bs

-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.
-- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.
-- It must not be stored or used after the subcomputation finishes.
--
-- @since 0.10.10.0
useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ShortByteString
bs CStringLen -> IO a
action =
  Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
l ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
      ShortByteString -> Int -> CString -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
copyToPtr ShortByteString
bs Int
0 CString
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
      CStringLen -> IO a
action (CString
buf, Int
l)
  where l :: Int
l = ShortByteString -> Int
length ShortByteString
bs

-- ---------------------------------------------------------------------
-- Internal utilities

moduleErrorIO :: HasCallStack => String -> String -> IO a
moduleErrorIO :: String -> String -> IO a
moduleErrorIO String
fun String
msg = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> (String -> IOError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String -> ShowS
moduleErrorMsg String
fun String
msg
{-# NOINLINE moduleErrorIO #-}

moduleErrorMsg :: String -> String -> String
moduleErrorMsg :: String -> ShowS
moduleErrorMsg String
fun String
msg = String
"Data.ByteString.Short." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
msg