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