{-# 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
(+.) = 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
    Word16
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
    Word16
w1 <-                Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> IO Word8 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> IO Word16) -> Word16 -> IO Word16
forall a b. (a -> b) -> a -> b
$ Word16
w0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
w1
{-# INLINE peek16 #-}

-- |
--
-- >>> 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 <- (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
    Word32
w1 <- (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Word32
w2 <-                 Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w2
{-# INLINE peek24 #-}

-- |
--
-- >>> 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 <- (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
    Word32
w1 <- (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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Word32
w2 <- (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    Word32
w3 <-                 Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w3
{-# INLINE peek32 #-}

-- |
--
-- >>> 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 <- (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
    Word64
w1 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Word64
w2 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    Word64
w3 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
    Word64
w4 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
    Word64
w5 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
    Word64
w6 <- (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
    Word64
w7 <-                 Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
peek8 Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64
w0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w5 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w7
{-# INLINE peek64 #-}

peekByteString :: Buffer -> Int -> IO ByteString
peekByteString :: Ptr Word8 -> Int -> IO ByteString
peekByteString Ptr Word8
src Int
len = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
{-# INLINE peekByteString #-}

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

-- |
--
-- >>> 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 ()
memcpy Ptr Word8
ptr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
    Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l
{-# INLINE copy #-}

-- | 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 <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
ptr
    ByteString -> IO a
io (ByteString -> IO a) -> ByteString -> IO a
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 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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
w
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word16 -> Ptr Word8 -> Int -> IO ()
poke16 Word16
w Ptr Word8
ptr Int
0
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Ptr Word8 -> Int -> IO ()
poke24 Word32
w Ptr Word8
ptr Int
0
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Ptr Word8 -> Int -> IO ()
poke32 Word32
w Ptr Word8
ptr Int
0
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word64 -> Ptr Word8 -> Int -> IO ()
poke64 Word64
w Ptr Word8
ptr Int
0
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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
_   = () -> 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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then do
        let src :: Ptr b
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 b
dst = Ptr Any
forall {b}. Ptr b
src Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftLeft Ptr Word8
forall {b}. Ptr b
dst Ptr Word8
forall {b}. Ptr b
src Int
len
        IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
forall {b}. Ptr b
ptr'
      else do
        let src :: Ptr b
src = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
            dst :: Ptr b
dst = Ptr Any
forall {b}. Ptr b
ptr' Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
shiftRight Ptr Word8
forall {b}. Ptr b
dst Ptr Word8
forall {b}. Ptr b
src Int
len
        IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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   = () -> 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
    Ptr Word8
dst <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let dst' :: Ptr b
dst' = Ptr Word8
dst Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
dst' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
forall {b}. Ptr b
src Int
len
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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
    Ptr Word8
dst <- IORef (Ptr Word8) -> IO (Ptr Word8)
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 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
dst' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    ShortByteString -> Int -> Ptr Word8 -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
Short.copyToPtr ShortByteString
sbs Int
0 Ptr Word8
dst Int
len
    IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let len :: Int
len = Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
    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
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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
    let len :: Int
len = Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start
    Ptr Word8 -> Int -> IO ShortByteString
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 = 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
    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 = 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
    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
    (ByteString, a) -> IO (ByteString, a)
forall a. a -> IO a
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)
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
    -- | 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)
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        if Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
limit then do
            Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
            IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ()
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
1
            Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w
          else
            BufferOverrun -> IO Word8
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    {-# INLINE readInt8 #-}
    readInt8 :: WriteBuffer -> IO 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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        if Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
limit then do
            Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
            IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ()
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
1
            let i :: Int
i = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
            Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
          else
            Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
start) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
forall {b}. Ptr b
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun -- not >=
        IORef (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr Word8)
offset Ptr Word8
forall {b}. Ptr b
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8
limit Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
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 Word8
ptr <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
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)
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
        Ptr Word8
old <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
        Ptr Word8
cur <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
offset
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8
cur Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
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
        Ptr Word8
old <- IORef (Ptr Word8) -> IO (Ptr Word8)
forall a. IORef a -> IO a
readIORef IORef (Ptr Word8)
oldoffset
        IORef (Ptr Word8) -> Ptr Word8 -> IO ()
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) = 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
    ReadBuffer
nsrc <- Ptr Word8 -> Int -> IO ReadBuffer
newReadBuffer Ptr Word8
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 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
    ByteString
bs <- a -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
        Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
len
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  | Bool
otherwise = a -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
      let src :: Ptr b
src = Ptr Word8
src0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
      let len' :: Int
len' = Int -> Int
forall a. Num a => a -> a
negate Int
len
      Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len' ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
forall {b}. Ptr b
src Int
len'
{-# INLINE extractByteString #-}

-- | 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
    ShortByteString
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
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
len
    ShortByteString -> IO ShortByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortByteString
sbs
  | Bool
otherwise = a -> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall b. a -> (Ptr Word8 -> IO b) -> IO b
forall a b. Readable a => a -> (Ptr Word8 -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Ptr Word8 -> IO ShortByteString) -> IO ShortByteString)
-> (Ptr Word8 -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
      let src :: Ptr b
src = Ptr Word8
src0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
      let len' :: Int
len' = Int -> Int
forall a. Num a => a -> a
negate Int
len
      Ptr Any -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
Short.createFromPtr Ptr Any
forall {b}. Ptr b
src Int
len'
{-# INLINE extractShortByteString #-}

-- | 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
    Word16
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)
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
2
    Word16 -> IO Word16
forall a. a -> IO a
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
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
3
    Word32
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)
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
3
    Word32 -> IO Word32
forall a. a -> IO a
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
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
4
    Word32
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)
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
4
    Word32 -> IO Word32
forall a. a -> IO a
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
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
checkR a
rbuf Int
8
    Word64
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)
    a -> Int -> IO ()
forall a. Readable a => a -> Int -> IO ()
ff a
rbuf Int
8
    Word64 -> IO Word64
forall a. a -> IO a
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 <- a -> IO Int
forall a. Readable a => a -> IO Int
remainingSize a
rbuf
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siz) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
{-# INLINE checkR #-}

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