{-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes,
             ForeignFunctionInterface, MagicHash, UnboxedTuples,
             UnliftedFFITypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Unsafe #-}
#endif
{-# 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, c_strlen)

import Data.Typeable    (Typeable)
import Data.Data        (Data(..), mkNoRepType)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup   (Semigroup((<>)))
#endif
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)
#if MIN_VERSION_base(4,7,0)
import Foreign.C.Types  (CSize(..), CInt(..))
#elif MIN_VERSION_base(4,4,0)
import Foreign.C.Types  (CSize(..), CInt(..), CLong(..))
#else
import Foreign.C.Types  (CSize, CInt, CLong)
#endif
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.ForeignPtr (touchForeignPtr)
#if MIN_VERSION_base(4,5,0)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
#else
import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
#endif
import Foreign.Storable (pokeByteOff)

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

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

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

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

#if MIN_VERSION_base(4,9,0)
instance Semigroup ShortByteString where
    <> :: ShortByteString -> ShortByteString -> ShortByteString
(<>)    = ShortByteString -> ShortByteString -> ShortByteString
append
#endif

instance Monoid ShortByteString where
    mempty :: ShortByteString
mempty  = ShortByteString
empty
#if MIN_VERSION_base(4,9,0)
    mappend :: ShortByteString -> ShortByteString -> ShortByteString
mappend = ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
(<>)
#else
    mappend = append
#endif
    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 ]

#if MIN_VERSION_base(4,7,0)
-- | @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
#endif

-- | 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 :: 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. 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 :: 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
")"


------------------------------------------------------------------------
-- 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
#if MIN_VERSION_base(4,6,0)
    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)
#else
    -- Before base 4.6 ForeignPtrContents is not exported from GHC.ForeignPtr
    -- so we cannot get direct access to the mbarr#
    let len = length sbs
    fptr <- mallocPlainForeignPtrBytes len
    let ptr = unsafeForeignPtrToPtr fptr
    stToIO (copyByteArrayToAddr (asBA sbs) 0 ptr len)
    touchForeignPtr fptr
    return (BS fptr len)
#endif


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

#if MIN_VERSION_base(4,6,0)
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# #)
#endif

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

#if MIN_VERSION_base(4,7,0)

-- These exist as real primops in ghc-7.8, and for before that we use
-- FFI to C memcpy.
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#

#else

copyAddrToByteArray# src dst dst_off len =
  unIO_ (memcpy_AddrToByteArray dst (csize dst_off) src 0 (csize len))

copyAddrToByteArray0 :: Addr# -> MutableByteArray# s -> Int#
                     -> State# RealWorld -> State# RealWorld
copyAddrToByteArray0 src dst len =
  unIO_ (memcpy_AddrToByteArray0 dst src (csize len))

{-# INLINE [0] copyAddrToByteArray# #-}
{-# RULES "copyAddrToByteArray# dst_off=0"
      forall src dst len s.
          copyAddrToByteArray# src dst 0# len s
        = copyAddrToByteArray0 src dst    len s  #-}

foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
  memcpy_AddrToByteArray :: MutableByteArray# s -> CSize -> Addr# -> CSize -> CSize -> IO ()

foreign import ccall unsafe "string.h memcpy"
  memcpy_AddrToByteArray0 :: MutableByteArray# s -> Addr# -> CSize -> IO ()


copyByteArrayToAddr# src src_off dst len =
  unIO_ (memcpy_ByteArrayToAddr dst 0 src (csize src_off) (csize len))

copyByteArrayToAddr0 :: ByteArray# -> Addr# -> Int#
                     -> State# RealWorld -> State# RealWorld
copyByteArrayToAddr0 src dst len =
  unIO_ (memcpy_ByteArrayToAddr0 dst src (csize len))

{-# INLINE [0] copyByteArrayToAddr# #-}
{-# RULES "copyByteArrayToAddr# src_off=0"
      forall src dst len s.
          copyByteArrayToAddr# src 0# dst len s
        = copyByteArrayToAddr0 src    dst len s  #-}

foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
  memcpy_ByteArrayToAddr :: Addr# -> CSize -> ByteArray# -> CSize -> CSize -> IO ()

foreign import ccall unsafe "string.h memcpy"
  memcpy_ByteArrayToAddr0 :: Addr# -> ByteArray# -> CSize -> IO ()


unIO_ :: IO () -> State# RealWorld -> State# RealWorld
unIO_ io s = case unIO io s of (# s, _ #) -> s

csize :: Int# -> CSize
csize i# = fromIntegral (I# i#)
#endif

#if MIN_VERSION_base(4,5,0)
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#
#else
copyByteArray# src src_off dst dst_off len s =
    unST_ (unsafeIOToST
      (memcpy_ByteArray dst (csize dst_off) src (csize src_off) (csize len))) s
  where
    unST (ST st) = st
    unST_ st s = case unST st s of (# s, _ #) -> s

foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
  memcpy_ByteArray :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
#endif

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