{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}

-- | Peek and poke functions for network byte order.
module Network.ByteOrder (
    -- * Types
    Buffer,
    Offset,
    BufferSize,
    BufferOverrun (..),

    -- * Poking
    poke8,
    poke16,
    poke24,
    poke32,
    poke64,

    -- * Peeking
    peek8,
    peek16,
    peek24,
    peek32,
    peek64,
    peekByteString,

    -- * From Word to ByteString
    bytestring8,
    bytestring16,
    bytestring32,
    bytestring64,

    -- * From ByteString to Word
    word8,
    word16,
    word32,
    word64,

    -- * Utilities
    unsafeWithByteString,
    copy,
    bufferIO,

    -- * Class to read a buffer
    Readable (..),

    -- * Reading from buffer
    ReadBuffer,
    newReadBuffer,
    withReadBuffer,
    read16,
    read24,
    read32,
    read64,
    extractByteString,
    extractShortByteString,

    -- * Writing to buffer
    WriteBuffer (..),
    newWriteBuffer,
    clearWriteBuffer,
    withWriteBuffer,
    withWriteBuffer',
    write8,
    write16,
    write24,
    write32,
    write64,
    copyByteString,
    copyShortByteString,
    shiftLastN,
    toByteString,
    toShortByteString,
    currentOffset,

    -- * Re-exporting
    Word8,
    Word16,
    Word32,
    Word64,
    ByteString,
) where

import Control.Exception (Exception, bracket, throwIO)
import Control.Monad (when)
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.ByteString.Internal (
    ByteString (..),
    create,
    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 (Word16, Word32, Word64, Word8)
import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (peek, poke)
import System.IO.Unsafe (unsafeDupablePerformIO)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.ByteString hiding (foldl')
-- >>> import Data.Word
-- >>> import Data.List

----------------------------------------------------------------

-- | A pointer to 'Word8'.
type Buffer = Ptr Word8

-- | Offset from the current pointer.
type Offset = Int

-- | Size of a buffer.
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

----------------------------------------------------------------

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf (poke8 0)
-- >>> unpack buf
-- [0,2,3,4]
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf (poke16 (7*256 + 8))
-- >>> unpack buf
-- [7,8,3,4]
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf (poke24 (6*65536 + 7*256 + 8))
-- >>> unpack buf
-- [6,7,8,4]
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf (poke32 (6*65536 + 7*256 + 8))
-- >>> unpack buf
-- [0,6,7,8]
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> unsafeWithByteString buf (poke64 (6*65536 + 7*256 + 8))
-- >>> unpack buf
-- [0,0,0,0,0,6,7,8]
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 #-}

----------------------------------------------------------------

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek8
-- 1
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek16
-- 258
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek24
-- 66051
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek32
-- 16909060
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> unsafeWithByteString buf peek64
-- 72623859790382856
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 ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dst Ptr Word8
src Int
len
{-# INLINE peekByteString #-}

----------------------------------------------------------------

-- |
--
-- >>> let w = 5 :: Word8
-- >>> unpack $ bytestring8 w
-- [5]
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 #-}

-- |
--
-- >>> let w = foldl' (\x y -> x * 256 + y) 0 [5,6] :: Word16
-- >>> unpack $ bytestring16 w
-- [5,6]
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 #-}

-- |
--
-- >>> let w = foldl' (\x y -> x * 256 + y) 0 [5,6,7,8] :: Word32
-- >>> unpack $ bytestring32 w
-- [5,6,7,8]
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 #-}

-- |
--
-- >>> let w = foldl' (\x y -> x * 256 + y) 0 [1,2,3,4,5,6,7,8] :: Word64
-- >>> unpack $ bytestring64 w
-- [1,2,3,4,5,6,7,8]
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 #-}

----------------------------------------------------------------

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> word8 buf
-- 1
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> word16 buf
-- 258
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> word32 buf
-- 16909060
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 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> word64 buf
-- 72623859790382856
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 #-}

----------------------------------------------------------------

-- | Using 'ByteString' as 'Buffer' and call the 'IO' action
--   of the second argument by passing the start point and the offset
--   of the 'ByteString'.
--   Note that if a 'ByteString' is created newly, its offset is 0.
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

-- | Copying the bytestring to the buffer.
--   This function returns the point where the next copy should start.
--
-- >>> let buf = "abc" :: ByteString
-- >>> unsafeWithByteString buf $ \ptr _ -> Network.ByteOrder.copy ptr "ABC" >> return buf
-- "ABC"
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 ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes 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 #-}

-- | Converting the part of buffer to 'ByteString' and executing the
--   action with it.
--
-- >>> let buf = "abcdef" :: ByteString
-- >>> unsafeWithByteString buf $ \ptr _-> bufferIO ptr 2 return
-- "ab"
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

----------------------------------------------------------------

-- | Read and write buffer.
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
    }

-- | Creating a write buffer with the given 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

-- | Reseting a write buffer.
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

-- | Write one byte and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 1 $ \wbuf -> write8 wbuf 65
-- "A"
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 #-}

-- | Write two bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 2 $ \wbuf -> write16 wbuf (65 * 256 + 66)
-- "AB"
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 #-}

-- | Write three bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 3 $ \wbuf -> write24 wbuf (65 * 256^(2 :: Int) + 66 * 256 + 67)
-- "ABC"
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 #-}

-- | Write four bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 4 $ \wbuf -> write32 wbuf (65 * 256^(3 :: Int) + 66 * 256^(2 :: Int) + 67 * 256 + 68)
-- "ABCD"
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 #-}

-- | Write four bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
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 #-}

-- | Shifting the N-bytes area just before the current pointer (the 3rd argument).
--   If the second argument is positive, shift it to right.
--   If it is negative, shift it to left.
--   'offset' moves as if it is sticky to the area.
--
-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCD" >> shiftLastN wbuf 1 3
-- "ABBCD"
-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCD" >> shiftLastN wbuf 2 3
-- "ABCBCD"
-- >>> withWriteBuffer 16 $ \wbuf -> copyByteString wbuf "ABCDE" >> shiftLastN wbuf (-2) 3 >> ff wbuf 2
-- "CDEDE"
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 (ZonkAny 1)
forall {b}. Ptr b
src Ptr (ZonkAny 1) -> 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 (ZonkAny 2)
forall {b}. Ptr b
ptr' Ptr (ZonkAny 2) -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
            shiftRight dst src len
            writeIORef offset ptr'
  where
    -- copyBytes cannot be used for overlapped areas.
    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 #-}

-- | Copy the content of 'ByteString' and ff its length.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 3 $ \wbuf -> copyByteString wbuf "ABC"
-- "ABC"
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
    copyBytes dst src len
    writeIORef offset dst'
{-# INLINE copyByteString #-}

-- | Copy the content of 'ShortByteString' and ff its length.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 5 $ \wbuf -> copyShortByteString wbuf "ABCEF"
-- "ABCEF"
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 #-}

-- | Copy the area from 'start' to the current pointer to 'ByteString'.
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 ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p Ptr Word8
start Int
len
{-# INLINE toByteString #-}

-- | Copy the area from 'start' to the current pointer to 'ShortByteString'.
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 #-}

-- | Allocate a temporary buffer and copy the result to 'ByteString'.
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

-- | Allocate a temporary buffer and copy the result to 'ByteString' with
--   an additional value.
--
-- >>> withWriteBuffer' 1 $ \wbuf -> write8 wbuf 65 >> return 'a'
-- ("A",'a')
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)

-- | Getting the offset pointer.
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
    -- | Reading one byte as 'Word8' and ff one byte.
    read8 :: a -> IO Word8

    -- | Reading one byte as 'Int' and ff one byte. If buffer overrun occurs, -1 is returned.
    readInt8 :: a -> IO Int

    -- | Fast forward the offset pointer. The boundary is not checked.
    ff :: a -> Offset -> IO ()

    -- | Returning the length of the remaining
    remainingSize :: a -> IO Int

    -- | Getting the current offset
    --
    -- @since 0.1.7
    position :: a -> IO Int

    -- | Executing an action on the current offset pointer.
    withCurrentOffSet :: a -> (Buffer -> IO b) -> IO b

    -- | Memorizing the current offset pointer.
    save :: a -> IO ()

    -- | Getting how many bytes from the saved offset pinter.
    savingSize :: a -> IO Int

    -- | Moving the offset point to the saved point.
    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 -- not >=
        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

----------------------------------------------------------------

-- | Read only buffer. To ensure that the internal is not modified,
--   this is an abstract data type.
newtype ReadBuffer = ReadBuffer WriteBuffer

-- | Creating a read buffer with the given buffer.
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

-- | Converting 'ByteString' to 'ReadBuffer' and run the action
--   with it.
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

-- | Extracting 'ByteString' from the current offset.
--   The contents is copied, not shared.
--   Its length is specified by the 2nd argument.
--   If the length is positive, the area after the current pointer is extracted and FF the length finally.
--   If the length is negative, the area before the current pointer is extracted and does not FF.
--
-- >>> withReadBuffer "abcdefg" $ \rbuf -> ff rbuf 1 >> extractByteString rbuf 2
-- "bc"
extractByteString :: Readable a => a -> Int -> IO ByteString
extractByteString :: forall a. Readable a => a -> Int -> IO ByteString
extractByteString 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 ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes 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 ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dst Ptr Word8
forall {b}. Ptr b
src Int
len'
{-# INLINE extractByteString #-}

-- | Extracting 'ShortByteString' from the current offset.
--   The contents is copied, not shared.
--   Its length is specified by the 2nd argument.
--   If the length is positive, the area after the current pointer is extracted and FF the length finally.
--   If the length is negative, the area before the current pointer is extracted and does not FF.
--
-- >>> withReadBuffer "abcdefg" $ \rbuf -> ff rbuf 2 >> extractShortByteString rbuf 3
-- "cde"
extractShortByteString :: Readable a => a -> Int -> IO ShortByteString
extractShortByteString :: forall a. Readable a => a -> Int -> IO ShortByteString
extractShortByteString 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 (ZonkAny 0) -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr (ZonkAny 0)
forall {b}. Ptr b
src Int
len'
{-# INLINE extractShortByteString #-}

-- | Reading two bytes as 'Word16' and ff two bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read16
-- 1
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 #-}

-- | Reading three bytes as 'Word32' and ff three bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read24
-- 258
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 #-}

-- | Reading four bytes as 'Word32' and ff four bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read32
-- 66051
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 #-}

-- | Reading four bytes as 'Word64' and ff four bytes.
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 #-}

-- | Buffer overrun exception.
data BufferOverrun
    = -- | The buffer size is not enough
      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