{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module Network.ByteOrder (
Buffer
, Offset
, BufferSize
, BufferOverrun(..)
, poke8
, poke16
, poke24
, poke32
, poke64
, peek8
, peek16
, peek24
, peek32
, peek64
, peekByteString
, bytestring8
, bytestring16
, bytestring32
, bytestring64
, word8
, word16
, word32
, word64
, unsafeWithByteString
, copy
, bufferIO
, Readable(..)
, ReadBuffer
, newReadBuffer
, withReadBuffer
, read16
, read24
, read32
, read64
, extractByteString
, extractShortByteString
, WriteBuffer(..)
, newWriteBuffer
, clearWriteBuffer
, withWriteBuffer
, withWriteBuffer'
, write8
, write16
, write24
, write32
, write64
, copyByteString
, copyShortByteString
, shiftLastN
, toByteString
, toShortByteString
, currentOffset
, Word8, Word16, Word32, Word64, ByteString
) where
import Control.Exception (bracket, throwIO, Exception)
import Control.Monad (when)
import Data.Bits (shiftR, shiftL, (.&.), (.|.))
import Data.ByteString.Internal (ByteString(..), create, memcpy, ByteString(..), unsafeCreate)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short.Internal as Short
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Typeable
import Data.Word (Word8, Word8, Word16, Word32, Word64)
import Foreign.ForeignPtr (withForeignPtr, newForeignPtr_)
import Foreign.Marshal.Alloc
import Foreign.Ptr (Ptr, plusPtr, plusPtr, minusPtr)
import Foreign.Storable (peek, poke, poke, peek)
import System.IO.Unsafe (unsafeDupablePerformIO)
type Buffer = Ptr Word8
type Offset = Int
type BufferSize = Int
(+.) :: Buffer -> Offset -> Buffer
+. :: Ptr Word8 -> Int -> Ptr Word8
(+.) = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr
poke8 :: Word8 -> Buffer -> Offset -> IO ()
poke8 :: Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w Ptr Word8
ptr Int
off = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
+. Int
off) Word8
w
{-# INLINE poke8 #-}
poke16 :: Word16 -> Buffer -> Offset -> IO ()
poke16 :: Word16 -> Ptr Word8 -> Int -> IO ()
poke16 Word16
w Ptr Word8
ptr Int
off = do
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w0 Ptr Word8
ptr Int
off
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w1 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
w0 :: Word8
w0 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
w Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xff)
w1 :: Word8
w1 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xff)
{-# INLINE poke16 #-}
poke24 :: Word32 -> Buffer -> Offset -> IO ()
poke24 :: Word32 -> Ptr Word8 -> Int -> IO ()
poke24 Word32
w Ptr Word8
ptr Int
off = do
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w0 Ptr Word8
ptr Int
off
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w1 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
where
w0 :: Word8
w0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
{-# INLINE poke24 #-}
poke32 :: Word32 -> Buffer -> Offset -> IO ()
poke32 :: Word32 -> Ptr Word8 -> Int -> IO ()
poke32 Word32
w Ptr Word8
ptr Int
off = do
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w0 Ptr Word8
ptr Int
off
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w1 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w3 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
where
w0 :: Word8
w0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
w3 :: Word8
w3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
{-# INLINE poke32 #-}
poke64 :: Word64 -> Buffer -> Offset -> IO ()
poke64 :: Word64 -> Ptr Word8 -> Int -> IO ()
poke64 Word64
w Ptr Word8
ptr Int
off = do
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w0 Ptr Word8
ptr Int
off
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w1 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w3 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w4 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w5 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w6 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w7 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
where
w0 :: Word8
w0 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w1 :: Word8
w1 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w2 :: Word8
w2 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w3 :: Word8
w3 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w4 :: Word8
w4 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w5 :: Word8
w5 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w6 :: Word8
w6 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
w7 :: Word8
w7 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
{-# INLINE poke64 #-}
peek8 :: Buffer -> Offset -> IO Word8
peek8 :: Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
+. Int
off)
{-# INLINE peek8 #-}
peek16 :: Buffer -> Offset -> IO Word16
peek16 :: Ptr Word8 -> Int -> IO Word16
peek16 Ptr Word8
ptr Int
off = do
w0 <- (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) (Word16 -> Word16) -> (Word8 -> Word16) -> Word8 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> IO Word8 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
w1 <- fromIntegral <$> peek8 ptr (off + 1)
return $ w0 .|. w1
{-# INLINE peek16 #-}
peek24 :: Buffer -> Offset -> IO Word32
peek24 :: Ptr Word8 -> Int -> IO Word32
peek24 Ptr Word8
ptr Int
off = do
w0 <- (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
w1 <- (`shiftL` 8) . fromIntegral <$> peek8 ptr (off + 1)
w2 <- fromIntegral <$> peek8 ptr (off + 2)
return $ w0 .|. w1 .|. w2
{-# INLINE peek24 #-}
peek32 :: Buffer -> Offset -> IO Word32
peek32 :: Ptr Word8 -> Int -> IO Word32
peek32 Ptr Word8
ptr Int
off = do
w0 <- (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
w1 <- (`shiftL` 16) . fromIntegral <$> peek8 ptr (off + 1)
w2 <- (`shiftL` 8) . fromIntegral <$> peek8 ptr (off + 2)
w3 <- fromIntegral <$> peek8 ptr (off + 3)
return $ w0 .|. w1 .|. w2 .|. w3
{-# INLINE peek32 #-}
peek64 :: Buffer -> Offset -> IO Word64
peek64 :: Ptr Word8 -> Int -> IO Word64
peek64 Ptr Word8
ptr Int
off = do
w0 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
w1 <- (`shiftL` 48) . fromIntegral <$> peek8 ptr (off + 1)
w2 <- (`shiftL` 40) . fromIntegral <$> peek8 ptr (off + 2)
w3 <- (`shiftL` 32) . fromIntegral <$> peek8 ptr (off + 3)
w4 <- (`shiftL` 24) . fromIntegral <$> peek8 ptr (off + 4)
w5 <- (`shiftL` 16) . fromIntegral <$> peek8 ptr (off + 5)
w6 <- (`shiftL` 8) . fromIntegral <$> peek8 ptr (off + 6)
w7 <- fromIntegral <$> peek8 ptr (off + 7)
return $ w0 .|. w1 .|. w2 .|. w3 .|. w4 .|. w5 .|. w6 .|. w7
{-# INLINE peek64 #-}
peekByteString :: Buffer -> Int -> IO ByteString
peekByteString :: Ptr Word8 -> Int -> IO ByteString
peekByteString Ptr Word8
src Int
len = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
{-# INLINE peekByteString #-}
bytestring8 :: Word8 -> ByteString
bytestring8 :: Word8 -> ByteString
bytestring8 Word8
w = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
1 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w Ptr Word8
ptr Int
0
{-# INLINE bytestring8 #-}
bytestring16 :: Word16 -> ByteString
bytestring16 :: Word16 -> ByteString
bytestring16 Word16
w = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
2 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Word16 -> Ptr Word8 -> Int -> IO ()
poke16 Word16
w Ptr Word8
ptr Int
0
{-# INLINE bytestring16 #-}
bytestring32 :: Word32 -> ByteString
bytestring32 :: Word32 -> ByteString
bytestring32 Word32
w = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
4 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Word32 -> Ptr Word8 -> Int -> IO ()
poke32 Word32
w Ptr Word8
ptr Int
0
{-# INLINE bytestring32 #-}
bytestring64 :: Word64 -> ByteString
bytestring64 :: Word64 -> ByteString
bytestring64 Word64
w = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
8 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Word64 -> Ptr Word8 -> Int -> IO ()
poke64 Word64
w Ptr Word8
ptr Int
0
{-# INLINE bytestring64 #-}
word8 :: ByteString -> Word8
word8 :: ByteString -> Word8
word8 ByteString
bs = IO Word8 -> Word8
forall a. IO a -> a
unsafeDupablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Word8 -> Int -> IO Word8) -> IO Word8
forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
unsafeWithByteString ByteString
bs Ptr Word8 -> Int -> IO Word8
peek8
{-# NOINLINE word8 #-}
word16 :: ByteString -> Word16
word16 :: ByteString -> Word16
word16 ByteString
bs = IO Word16 -> Word16
forall a. IO a -> a
unsafeDupablePerformIO (IO Word16 -> Word16) -> IO Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Word8 -> Int -> IO Word16) -> IO Word16
forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
unsafeWithByteString ByteString
bs Ptr Word8 -> Int -> IO Word16
peek16
{-# NOINLINE word16 #-}
word32 :: ByteString -> Word32
word32 :: ByteString -> Word32
word32 ByteString
bs = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Word8 -> Int -> IO Word32) -> IO Word32
forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
unsafeWithByteString ByteString
bs Ptr Word8 -> Int -> IO Word32
peek32
{-# NOINLINE word32 #-}
word64 :: ByteString -> Word64
word64 :: ByteString -> Word64
word64 ByteString
bs = IO Word64 -> Word64
forall a. IO a -> a
unsafeDupablePerformIO (IO Word64 -> Word64) -> IO Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Word8 -> Int -> IO Word64) -> IO Word64
forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
unsafeWithByteString ByteString
bs Ptr Word8 -> Int -> IO Word64
peek64
{-# NOINLINE word64 #-}
unsafeWithByteString :: ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString :: forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
unsafeWithByteString (PS ForeignPtr Word8
fptr Int
off Int
_) Ptr Word8 -> Int -> IO a
io = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\Ptr Word8
ptr -> Ptr Word8 -> Int -> IO a
io Ptr Word8
ptr Int
off
copy :: Buffer -> ByteString -> IO Buffer
copy :: Ptr Word8 -> ByteString -> IO (Ptr Word8)
copy Ptr Word8
ptr (PS ForeignPtr Word8
fp Int
o Int
l) = ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
ptr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l
{-# INLINE copy #-}
bufferIO :: Buffer -> Int -> (ByteString -> IO a) -> IO a
bufferIO :: forall a. Ptr Word8 -> Int -> (ByteString -> IO a) -> IO a
bufferIO Ptr Word8
ptr Int
siz ByteString -> IO a
io = do
fptr <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
ptr
io $ PS fptr 0 siz
data WriteBuffer = WriteBuffer {
WriteBuffer -> Ptr Word8
start :: Buffer
, WriteBuffer -> Ptr Word8
limit :: Buffer
, WriteBuffer -> IORef (Ptr Word8)
offset :: IORef Buffer
, WriteBuffer -> IORef (Ptr Word8)
oldoffset :: IORef Buffer
}
newWriteBuffer :: Buffer -> BufferSize -> IO WriteBuffer
newWriteBuffer :: Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz =
Ptr Word8
-> Ptr Word8
-> IORef (Ptr Word8)
-> IORef (Ptr Word8)
-> WriteBuffer
WriteBuffer Ptr Word8
buf (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
siz) (IORef (Ptr Word8) -> IORef (Ptr Word8) -> WriteBuffer)
-> IO (IORef (Ptr Word8)) -> IO (IORef (Ptr Word8) -> WriteBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO (IORef (Ptr Word8))
forall a. a -> IO (IORef a)
newIORef Ptr Word8
buf IO (IORef (Ptr Word8) -> WriteBuffer)
-> IO (IORef (Ptr Word8)) -> IO WriteBuffer
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO (IORef (Ptr Word8))
forall a. a -> IO (IORef a)
newIORef Ptr Word8
buf
clearWriteBuffer :: WriteBuffer -> IO ()
clearWriteBuffer :: WriteBuffer -> IO ()
clearWriteBuffer WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
start
IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
oldoffset Ptr Word8
start
write8 :: WriteBuffer -> Word8 -> IO ()
write8 :: WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Word8
w = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
when (ptr' > limit) $ throwIO BufferOverrun
poke ptr w
writeIORef offset ptr'
{-# INLINE write8 #-}
write16 :: WriteBuffer -> Word16 -> IO ()
write16 :: WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Word16
w = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2
when (ptr' > limit) $ throwIO BufferOverrun
poke16 w ptr 0
writeIORef offset ptr'
{-# INLINE write16 #-}
write24 :: WriteBuffer -> Word32 -> IO ()
write24 :: WriteBuffer -> Word32 -> IO ()
write24 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Word32
w = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3
when (ptr' > limit) $ throwIO BufferOverrun
poke24 w ptr 0
writeIORef offset ptr'
{-# INLINE write24 #-}
write32 :: WriteBuffer -> Word32 -> IO ()
write32 :: WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Word32
w = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
when (ptr' > limit) $ throwIO BufferOverrun
poke32 w ptr 0
writeIORef offset ptr'
{-# INLINE write32 #-}
write64 :: WriteBuffer -> Word64 -> IO ()
write64 :: WriteBuffer -> Word64 -> IO ()
write64 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Word64
w = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8
when (ptr' > limit) $ throwIO BufferOverrun
poke64 w ptr 0
writeIORef offset ptr'
{-# INLINE write64 #-}
shiftLastN :: WriteBuffer -> Int -> Int -> IO ()
shiftLastN :: WriteBuffer -> Int -> Int -> IO ()
shiftLastN WriteBuffer
_ Int
0 Int
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shiftLastN WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Int
i Int
len = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
when (ptr' >= limit) $ throwIO BufferOverrun
if i < 0 then do
let src = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate Int
len
dst = Ptr Any
forall {b}. Ptr b
src Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
shiftLeft dst src len
writeIORef offset ptr'
else do
let src = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
dst = Ptr Any
forall {b}. Ptr b
ptr' Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
shiftRight dst src len
writeIORef offset ptr'
where
shiftLeft :: Buffer -> Buffer -> Int -> IO ()
shiftLeft :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftLeft Ptr Word8
_ Ptr Word8
_ Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shiftLeft Ptr Word8
dst Ptr Word8
src Int
n = do
Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src IO Word8 -> (Word8 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftLeft (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
shiftRight :: Buffer -> Buffer -> Int -> IO ()
shiftRight :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftRight Ptr Word8
_ Ptr Word8
_ Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shiftRight Ptr Word8
dst Ptr Word8
src Int
n = do
Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src IO Word8 -> (Word8 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftRight (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE shiftLastN #-}
copyByteString :: WriteBuffer -> ByteString -> IO ()
copyByteString :: WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} (PS ForeignPtr Word8
fptr Int
off Int
len) = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let src :: Ptr b
src = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
dst <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let dst' = Ptr Word8
dst Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
when (dst' > limit) $ throwIO BufferOverrun
memcpy dst src len
writeIORef offset dst'
{-# INLINE copyByteString #-}
copyShortByteString :: WriteBuffer -> ShortByteString -> IO ()
copyShortByteString :: WriteBuffer -> ShortByteString -> IO ()
copyShortByteString WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} ShortByteString
sbs = do
dst <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let len = ShortByteString -> Int
Short.length ShortByteString
sbs
let dst' = Ptr Word8
dst Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
when (dst' > limit) $ throwIO BufferOverrun
Short.copyToPtr sbs 0 dst len
writeIORef offset dst'
{-# INLINE copyShortByteString #-}
toByteString :: WriteBuffer -> IO ByteString
toByteString :: WriteBuffer -> IO ByteString
toByteString WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let len = Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
create len $ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p Ptr Word8
start Int
len
{-# INLINE toByteString #-}
toShortByteString :: WriteBuffer -> IO ShortByteString
toShortByteString :: WriteBuffer -> IO ShortByteString
toShortByteString WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let len = Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
Short.createFromPtr start len
{-# INLINE toShortByteString #-}
withWriteBuffer :: BufferSize -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer :: Int -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Int
siz WriteBuffer -> IO ()
action = IO (Ptr Word8)
-> (Ptr Word8 -> IO ())
-> (Ptr Word8 -> IO ByteString)
-> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
siz) Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
wbuf <- Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz
action wbuf
toByteString wbuf
withWriteBuffer' :: BufferSize -> (WriteBuffer -> IO a) -> IO (ByteString, a)
withWriteBuffer' :: forall a. Int -> (WriteBuffer -> IO a) -> IO (ByteString, a)
withWriteBuffer' Int
siz WriteBuffer -> IO a
action = IO (Ptr Word8)
-> (Ptr Word8 -> IO ())
-> (Ptr Word8 -> IO (ByteString, a))
-> IO (ByteString, a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
siz) Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free ((Ptr Word8 -> IO (ByteString, a)) -> IO (ByteString, a))
-> (Ptr Word8 -> IO (ByteString, a)) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
wbuf <- Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz
x <- action wbuf
bs <- toByteString wbuf
return (bs,x)
currentOffset :: WriteBuffer -> IO Buffer
currentOffset :: WriteBuffer -> IO (Ptr Word8)
currentOffset WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
{-# INLINE currentOffset #-}
class Readable a where
read8 :: a -> IO Word8
readInt8 :: a -> IO Int
ff :: a -> Offset -> IO ()
remainingSize :: a -> IO Int
position :: a -> IO Int
withCurrentOffSet :: a -> (Buffer -> IO b) -> IO b
save :: a -> IO ()
savingSize :: a -> IO Int
goBack :: a -> IO ()
instance Readable WriteBuffer where
{-# INLINE read8 #-}
read8 :: WriteBuffer -> IO Word8
read8 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
if ptr < limit then do
w <- peek ptr
writeIORef offset $ ptr `plusPtr` 1
return w
else
throwIO BufferOverrun
{-# INLINE readInt8 #-}
readInt8 :: WriteBuffer -> IO Int
readInt8 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
if ptr < limit then do
w <- peek ptr
writeIORef offset $ ptr `plusPtr` 1
let i = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
return i
else
return (-1)
{-# INLINE ff #-}
ff :: WriteBuffer -> Int -> IO ()
ff WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Int
n = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
let ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
when (ptr' < start) $ throwIO BufferOverrun
when (ptr' > limit) $ throwIO BufferOverrun
writeIORef offset ptr'
{-# INLINE remainingSize #-}
remainingSize :: WriteBuffer -> IO Int
remainingSize WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
return $ limit `minusPtr` ptr
position :: WriteBuffer -> IO Int
position WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
return $ ptr `minusPtr` start
{-# INLINE withCurrentOffSet #-}
withCurrentOffSet :: forall b. WriteBuffer -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} Ptr Word8 -> IO b
action = IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset IO (Ptr Word8) -> (Ptr Word8 -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> IO b
action
{-# INLINE save #-}
save :: WriteBuffer -> IO ()
save WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset IO (Ptr Word8) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
oldoffset
{-# INLINE savingSize #-}
savingSize :: WriteBuffer -> IO Int
savingSize WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
old <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
cur <- readIORef offset
return $ cur `minusPtr` old
{-# INLINE goBack #-}
goBack :: WriteBuffer -> IO ()
goBack WriteBuffer{Ptr Word8
IORef (Ptr Word8)
start :: WriteBuffer -> Ptr Word8
limit :: WriteBuffer -> Ptr Word8
offset :: WriteBuffer -> IORef (Ptr Word8)
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
start :: Ptr Word8
limit :: Ptr Word8
offset :: IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
..} = do
old <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
writeIORef offset old
instance Readable ReadBuffer where
{-# INLINE read8 #-}
read8 :: ReadBuffer -> IO Word8
read8 (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 WriteBuffer
w
{-# INLINE readInt8 #-}
readInt8 :: ReadBuffer -> IO Int
readInt8 (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Int
forall a. Readable a => a -> IO Int
readInt8 WriteBuffer
w
{-# INLINE ff #-}
ff :: ReadBuffer -> Int -> IO ()
ff (ReadBuffer WriteBuffer
w) = WriteBuffer -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
w
{-# INLINE remainingSize #-}
remainingSize :: ReadBuffer -> IO Int
remainingSize (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize WriteBuffer
w
{-# INLINE position #-}
position :: ReadBuffer -> IO Int
position (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Int
forall a. Readable a => a -> IO Int
position WriteBuffer
w
{-# INLINE withCurrentOffSet #-}
withCurrentOffSet :: forall b. ReadBuffer -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet (ReadBuffer WriteBuffer
w) = WriteBuffer -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
forall b. WriteBuffer -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet WriteBuffer
w
{-# INLINE save #-}
save :: ReadBuffer -> IO ()
save (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO ()
forall a. Readable a => a -> IO ()
save WriteBuffer
w
{-# INLINE savingSize #-}
savingSize :: ReadBuffer -> IO Int
savingSize (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Int
forall a. Readable a => a -> IO Int
savingSize WriteBuffer
w
{-# INLINE goBack #-}
goBack :: ReadBuffer -> IO ()
goBack (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO ()
forall a. Readable a => a -> IO ()
goBack WriteBuffer
w
newtype ReadBuffer = ReadBuffer WriteBuffer
newReadBuffer :: Buffer -> BufferSize -> IO ReadBuffer
newReadBuffer :: Ptr Word8 -> Int -> IO ReadBuffer
newReadBuffer Ptr Word8
buf Int
siz = WriteBuffer -> ReadBuffer
ReadBuffer (WriteBuffer -> ReadBuffer) -> IO WriteBuffer -> IO ReadBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz
withReadBuffer :: ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer :: forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer (PS ForeignPtr Word8
fp Int
off Int
siz) ReadBuffer -> IO a
action = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let buf :: Ptr b
buf = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
nsrc <- Ptr Word8 -> Int -> IO ReadBuffer
newReadBuffer Ptr Word8
forall {b}. Ptr b
buf Int
siz
action nsrc
extractByteString :: Readable a => a -> Int -> IO ByteString
a
rbuf Int
len
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
len
bs <- a -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
ff rbuf len
return bs
| Bool
otherwise = a -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
let src :: Ptr b
src = Ptr Word8
src0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
let len' :: Int
len' = Int -> Int
forall a. Num a => a -> a
negate Int
len
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len' ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
forall {b}. Ptr b
src Int
len'
{-# INLINE extractByteString #-}
extractShortByteString :: Readable a => a -> Int -> IO ShortByteString
a
rbuf Int
len
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShortByteString -> IO ShortByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortByteString
forall a. Monoid a => a
mempty
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
len
sbs <- a -> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ShortByteString) -> IO ShortByteString)
-> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> Ptr Word8 -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr Word8
src Int
len
ff rbuf len
return sbs
| Bool
otherwise = a -> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ShortByteString) -> IO ShortByteString)
-> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
let src :: Ptr b
src = Ptr Word8
src0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
let len' :: Int
len' = Int -> Int
forall a. Num a => a -> a
negate Int
len
Ptr Any -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr Any
forall {b}. Ptr b
src Int
len'
{-# INLINE extractShortByteString #-}
read16 :: Readable a => a -> IO Word16
read16 :: forall a. Readable a => a -> IO Word16
read16 a
rbuf = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
2
w16 <- a -> (Ptr Word8 -> IO Word16) -> IO Word16
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word16
`peek16` Int
0)
ff rbuf 2
return w16
{-# INLINE read16 #-}
read24 :: Readable a => a -> IO Word32
read24 :: forall a. Readable a => a -> IO Word32
read24 a
rbuf = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
3
w24 <- a -> (Ptr Word8 -> IO Word32) -> IO Word32
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word32
`peek24` Int
0)
ff rbuf 3
return w24
{-# INLINE read24 #-}
read32 :: Readable a => a -> IO Word32
read32 :: forall a. Readable a => a -> IO Word32
read32 a
rbuf = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
4
w32 <- a -> (Ptr Word8 -> IO Word32) -> IO Word32
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word32
`peek32` Int
0)
ff rbuf 4
return w32
{-# INLINE read32 #-}
read64 :: Readable a => a -> IO Word64
read64 :: forall a. Readable a => a -> IO Word64
read64 a
rbuf = do
a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
8
w64 <- a -> (Ptr Word8 -> IO Word64) -> IO Word64
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word64
`peek64` Int
0)
ff rbuf 8
return w64
{-# INLINE read64 #-}
checkR :: Readable a => a -> Int -> IO ()
checkR :: forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
siz = do
left <- a -> IO Int
forall a. Readable a => a -> IO Int
remainingSize a
rbuf
when (left < siz) $ throwIO BufferOverrun
{-# INLINE checkR #-}
data BufferOverrun = BufferOverrun
deriving (BufferOverrun -> BufferOverrun -> Bool
(BufferOverrun -> BufferOverrun -> Bool)
-> (BufferOverrun -> BufferOverrun -> Bool) -> Eq BufferOverrun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferOverrun -> BufferOverrun -> Bool
== :: BufferOverrun -> BufferOverrun -> Bool
$c/= :: BufferOverrun -> BufferOverrun -> Bool
/= :: BufferOverrun -> BufferOverrun -> Bool
Eq,Int -> BufferOverrun -> ShowS
[BufferOverrun] -> ShowS
BufferOverrun -> String
(Int -> BufferOverrun -> ShowS)
-> (BufferOverrun -> String)
-> ([BufferOverrun] -> ShowS)
-> Show BufferOverrun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferOverrun -> ShowS
showsPrec :: Int -> BufferOverrun -> ShowS
$cshow :: BufferOverrun -> String
show :: BufferOverrun -> String
$cshowList :: [BufferOverrun] -> ShowS
showList :: [BufferOverrun] -> ShowS
Show,Typeable)
instance Exception BufferOverrun