{-# 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 (
ShortByteString(..),
toShort,
fromShort,
pack,
unpack,
empty, null, length, index, indexMaybe, (!?), unsafeIndex,
createFromPtr, copyToPtr,
packCString,
packCStringLen,
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
data ShortByteString = SBS ByteArray#
deriving Typeable
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
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 ]
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
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"
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 ())
length :: ShortByteString -> Int
length :: ShortByteString -> Int
length (SBS ByteArray#
barr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
barr#)
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
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
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 #-}
(!?) :: 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
")"
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
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 #-}
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#)
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)
pack :: [Word8] -> ShortByteString
pack :: [Word8] -> ShortByteString
pack = [Word8] -> ShortByteString
packBytes
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
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 []
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
unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]
!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)
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
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
copyToPtr :: ShortByteString
-> Int
-> Ptr a
-> Int
-> 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
-> Int
-> 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#)
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, () #)
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
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#
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)
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)
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
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
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