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

-- $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
(+.) = 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 = 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 forall a. Num a => a -> a -> a
+ Int
1)
  where
    w0 :: Word8
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) forall a. Bits a => a -> a -> a
.&. Word16
0xff)
    w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word16
w              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 forall a. Num a => a -> a -> a
+ Int
1)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
  where
    w0 :: Word8
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word32
w              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 forall a. Num a => a -> a -> a
+ Int
1)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w3 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
3)
  where
    w0 :: Word8
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24) forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word32
w              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 forall a. Num a => a -> a -> a
+ Int
1)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w2 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w3 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
3)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w4 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
4)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w5 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
5)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w6 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
6)
    Word8 -> Ptr Word8 -> Int -> IO ()
poke8 Word8
w7 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
7)
  where
    w0 :: Word8
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w5 :: Word8
w5 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w6 :: Word8
w6 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w7 :: Word8
w7 = forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word64
w              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 = 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
    Word16
w0 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
    Word16
w1 <-                forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
1)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word16
w0 forall a. Bits a => a -> a -> a
.|. Word16
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
    Word32
w0 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
    Word32
w1 <- (forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
1)
    Word32
w2 <-                 forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32
w0 forall a. Bits a => a -> a -> a
.|. Word32
w1 forall a. Bits a => a -> a -> a
.|. Word32
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
    Word32
w0 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
    Word32
w1 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
1)
    Word32
w2 <- (forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
    Word32
w3 <-                 forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
3)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32
w0 forall a. Bits a => a -> a -> a
.|. Word32
w1 forall a. Bits a => a -> a -> a
.|. Word32
w2 forall a. Bits a => a -> a -> a
.|. Word32
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
    Word64
w0 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
56) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr Int
off
    Word64
w1 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
48) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
1)
    Word64
w2 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
40) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
2)
    Word64
w3 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
32) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
3)
    Word64
w4 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
4)
    Word64
w5 <- (forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
5)
    Word64
w6 <- (forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
6)
    Word64
w7 <-                 forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off forall a. Num a => a -> a -> a
+ Int
7)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64
w0 forall a. Bits a => a -> a -> a
.|. Word64
w1 forall a. Bits a => a -> a -> a
.|. Word64
w2 forall a. Bits a => a -> a -> a
.|. Word64
w3 forall a. Bits a => a -> a -> a
.|. Word64
w4 forall a. Bits a => a -> a -> a
.|. Word64
w5 forall a. Bits a => a -> a -> a
.|. Word64
w6 forall a. Bits a => a -> a -> a
.|. Word64
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 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
{-# INLINE peekByteString #-}

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

-- |
--
-- >>> 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 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 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 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 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ 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 = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr 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) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
ptr (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr 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
    ForeignPtr Word8
fptr <- forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
ptr
    ByteString -> IO a
io forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr Int
0 Int
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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
siz) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef Ptr Word8
buf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
start
    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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Word8
w = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
w
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Word16
w = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word16 -> Ptr Word8 -> Int -> IO ()
poke16 Word16
w Ptr Word8
ptr Int
0
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Word32
w = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Ptr Word8 -> Int -> IO ()
poke24 Word32
w Ptr Word8
ptr Int
0
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Word32
w = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Ptr Word8 -> Int -> IO ()
poke32 Word32
w Ptr Word8
ptr Int
0
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Word64
w = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word64 -> Ptr Word8 -> Int -> IO ()
poke64 Word64
w Ptr Word8
ptr Int
0
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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
_   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
shiftLastN WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Int
i Int
len = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
>= Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    if Int
i forall a. Ord a => a -> a -> Bool
< Int
0 then do
        let src :: Ptr b
src = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate Int
len
            dst :: Ptr b
dst = forall {b}. Ptr b
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftLeft forall {b}. Ptr b
dst forall {b}. Ptr b
src Int
len
        forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
ptr'
      else do
        let src :: Ptr b
src = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
            dst :: Ptr b
dst = forall {b}. Ptr b
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftRight forall {b}. Ptr b
dst forall {b}. Ptr b
src Int
len
        forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
ptr'
  where
    -- memcpy 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   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    shiftLeft Ptr Word8
dst Ptr Word8
src Int
n = do
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftLeft (Ptr Word8
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
n 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   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    shiftRight Ptr Word8
dst Ptr Word8
src Int
n = do
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftRight (Ptr Word8
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (Int
n 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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} (PS ForeignPtr Word8
fptr Int
off Int
len) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    let src :: Ptr b
src = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
    Ptr Word8
dst <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let dst' :: Ptr b
dst' = Ptr Word8
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
dst' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst forall {b}. Ptr b
src Int
len
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} ShortByteString
sbs = do
    Ptr Word8
dst <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let len :: Int
len = ShortByteString -> Int
Short.length ShortByteString
sbs
    let dst' :: Ptr b
dst' = Ptr Word8
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
dst' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
Short.copyToPtr ShortByteString
sbs Int
0 Ptr Word8
dst Int
len
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let len :: Int
len = Ptr Word8
ptr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
    Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy 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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
    Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let len :: Int
len = Ptr Word8
ptr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
    forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr Word8
start Int
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 = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
mallocBytes Int
siz) forall a. Ptr a -> IO ()
free forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
    WriteBuffer
wbuf <- Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz
    WriteBuffer -> IO ()
action WriteBuffer
wbuf
    WriteBuffer -> IO ByteString
toByteString WriteBuffer
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 = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
mallocBytes Int
siz) forall a. Ptr a -> IO ()
free forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
    WriteBuffer
wbuf <- Ptr Word8 -> Int -> IO WriteBuffer
newWriteBuffer Ptr Word8
buf Int
siz
    a
x <- WriteBuffer -> IO a
action WriteBuffer
wbuf
    ByteString
bs <- WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,a
x)

-- | Getting the offset pointer.
currentOffset :: WriteBuffer -> IO Buffer
currentOffset :: WriteBuffer -> IO (Ptr Word8)
currentOffset WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> 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
    -- | Executing an action on the current offset pointer.
    position :: a -> IO Int
    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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        if Ptr Word8
ptr forall a. Ord a => a -> a -> Bool
< Ptr Word8
limit then do
            Word8
w <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w
          else
            forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    {-# INLINE readInt8 #-}
    readInt8 :: WriteBuffer -> IO Int
readInt8 WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        if Ptr Word8
ptr forall a. Ord a => a -> a -> Bool
< Ptr Word8
limit then do
            Word8
w <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
            let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
    {-# INLINE ff #-}
    ff :: WriteBuffer -> Int -> IO ()
ff WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Int
n = do
        Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        let ptr' :: Ptr b
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
< Ptr Word8
start) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {b}. Ptr b
ptr' forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun -- not >=
        forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset forall {b}. Ptr b
ptr'
    {-# INLINE remainingSize #-}
    remainingSize :: WriteBuffer -> IO Int
remainingSize WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8
limit forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
    position :: WriteBuffer -> IO Int
position WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
ptr <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
    {-# INLINE withCurrentOffSet #-}
    withCurrentOffSet :: forall b. WriteBuffer -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} Ptr Word8 -> IO b
action = forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset 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)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
oldoffset
    {-# INLINE savingSize #-}
    savingSize :: WriteBuffer -> IO Int
savingSize WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
old <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
        Ptr Word8
cur <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8
cur forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
old
    {-# INLINE goBack #-}
    goBack :: WriteBuffer -> IO ()
goBack WriteBuffer{Ptr Word8
IORef (Ptr Word8)
oldoffset :: IORef (Ptr Word8)
offset :: IORef (Ptr Word8)
limit :: Ptr Word8
start :: Ptr Word8
oldoffset :: WriteBuffer -> IORef (Ptr Word8)
offset :: WriteBuffer -> IORef (Ptr Word8)
limit :: WriteBuffer -> Ptr Word8
start :: WriteBuffer -> Ptr Word8
..} = do
        Ptr Word8
old <- forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
        forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
old

instance Readable ReadBuffer where
    {-# INLINE read8 #-}
    read8 :: ReadBuffer -> IO Word8
read8 (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> IO Word8
read8 WriteBuffer
w
    {-# INLINE readInt8 #-}
    readInt8 :: ReadBuffer -> IO Int
readInt8 (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> IO Int
readInt8 WriteBuffer
w
    {-# INLINE ff #-}
    ff :: ReadBuffer -> Int -> IO ()
ff (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> Int -> IO ()
ff WriteBuffer
w
    {-# INLINE remainingSize #-}
    remainingSize :: ReadBuffer -> IO Int
remainingSize (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> IO Int
remainingSize WriteBuffer
w
    {-# INLINE position #-}
    position :: ReadBuffer -> IO Int
position (ReadBuffer WriteBuffer
w) = 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) = forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet WriteBuffer
w
    {-# INLINE save #-}
    save :: ReadBuffer -> IO ()
save (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> IO ()
save WriteBuffer
w
    {-# INLINE savingSize #-}
    savingSize :: ReadBuffer -> IO Int
savingSize (ReadBuffer WriteBuffer
w) = forall a. Readable a => a -> IO Int
savingSize WriteBuffer
w
    {-# INLINE goBack #-}
    goBack :: ReadBuffer -> IO ()
goBack (ReadBuffer WriteBuffer
w) = 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 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 = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    let buf :: Ptr b
buf = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
    ReadBuffer
nsrc <- Ptr Word8 -> Int -> IO ReadBuffer
newReadBuffer forall {b}. Ptr b
buf Int
siz
    ReadBuffer -> IO a
action ReadBuffer
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 forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  | Int
len forall a. Ord a => a -> a -> Bool
>  Int
0 = do
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
len
    ByteString
bs <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
        Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
len
    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  | Bool
otherwise = forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
      let src :: Ptr b
src = Ptr Word8
src0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
      let len' :: Int
len' = forall a. Num a => a -> a
negate Int
len
      Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len' forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst 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 forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  | Int
len forall a. Ord a => a -> a -> Bool
>  Int
0 = do
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
len
    ShortByteString
sbs <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr Word8
src Int
len
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
len
    forall (m :: * -> *) a. Monad m => a -> m a
return ShortByteString
sbs
  | Bool
otherwise = forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
      let src :: Ptr b
src = Ptr Word8
src0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
      let len' :: Int
len' = forall a. Num a => a -> a
negate Int
len
      forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr 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
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
2
    Word16
w16 <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word16
`peek16` Int
0)
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
2
    forall (m :: * -> *) a. Monad m => a -> m a
return Word16
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
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
3
    Word32
w24 <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word32
`peek24` Int
0)
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
3
    forall (m :: * -> *) a. Monad m => a -> m a
return Word32
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
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
4
    Word32
w32 <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word32
`peek32` Int
0)
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
4
    forall (m :: * -> *) a. Monad m => a -> m a
return Word32
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
    forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
8
    Word64
w64 <- forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf (Ptr Word8 -> Int -> IO Word64
`peek64` Int
0)
    forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
8
    forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w64
{-# INLINE read64 #-}

checkR :: Readable a => a -> Int -> IO ()
checkR :: forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
siz = do
    Int
left <- forall a. Readable a => a -> IO Int
remainingSize a
rbuf
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
left forall a. Ord a => a -> a -> Bool
< Int
siz) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
{-# INLINE checkR #-}

-- | Buffer overrun exception.
data BufferOverrun = BufferOverrun -- ^ The buffer size is not enough
                     deriving (BufferOverrun -> BufferOverrun -> Bool
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,Int -> BufferOverrun -> ShowS
[BufferOverrun] -> ShowS
BufferOverrun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferOverrun] -> ShowS
$cshowList :: [BufferOverrun] -> ShowS
show :: BufferOverrun -> String
$cshow :: BufferOverrun -> String
showsPrec :: Int -> BufferOverrun -> ShowS
$cshowsPrec :: Int -> BufferOverrun -> ShowS
Show,Typeable)

instance Exception BufferOverrun