{-# 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
-- >>> 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
+. :: Buffer -> Offset -> Buffer
(+.) = Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> 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 -> Buffer -> Offset -> IO ()
poke8 Word8
w Buffer
ptr Offset
off = Buffer -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Buffer
ptr Buffer -> Offset -> Buffer
+. Offset
off) Word8
w
{-# INLINE poke8 #-}

-- |
--
-- >>> 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 -> Buffer -> Offset -> IO ()
poke16 Word16
w Buffer
ptr Offset
off = do
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w0 Buffer
ptr Offset
off
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w1 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
  where
    w0 :: Word8
w0 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
w Word16 -> Offset -> Word16
forall a. Bits a => a -> Offset -> a
`shiftR`  Offset
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xff)
    w1 :: Word8
w1 = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word16
w              Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xff)
{-# INLINE poke16 #-}

-- |
--
-- >>> 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 -> Buffer -> Offset -> IO ()
poke24 Word32
w Buffer
ptr Offset
off = do
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w0 Buffer
ptr Offset
off
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w1 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w2 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
  where
    w0 :: Word8
w0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftR`  Offset
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word32
w              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
{-# INLINE poke24 #-}

-- |
--
-- >>> 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 -> Buffer -> Offset -> IO ()
poke32 Word32
w Buffer
ptr Offset
off = do
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w0 Buffer
ptr Offset
off
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w1 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w2 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w3 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
3)
  where
    w0 :: Word8
w0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftR`  Offset
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
    w3 :: Word8
w3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word32
w              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
{-# INLINE poke32 #-}

-- |
--
-- >>> 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 -> Buffer -> Offset -> IO ()
poke64 Word64
w Buffer
ptr Offset
off = do
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w0 Buffer
ptr Offset
off
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w1 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w2 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w3 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
3)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w4 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
4)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w5 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
5)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w6 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
6)
    Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w7 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
7)
  where
    w0 :: Word8
w0 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w1 :: Word8
w1 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w2 :: Word8
w2 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w3 :: Word8
w3 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w4 :: Word8
w4 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w5 :: Word8
w5 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR` Offset
16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w6 :: Word8
w6 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftR`  Offset
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    w7 :: Word8
w7 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral  (Word64
w              Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
{-# INLINE poke64 #-}

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

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek8
-- 1
peek8 :: Buffer -> Offset -> IO Word8
peek8 :: Buffer -> Offset -> IO Word8
peek8 Buffer
ptr Offset
off = Buffer -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Buffer
ptr Buffer -> Offset -> Buffer
+. Offset
off)
{-# INLINE peek8 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek16
-- 258
peek16 :: Buffer -> Offset -> IO Word16
peek16 :: Buffer -> Offset -> IO Word16
peek16 Buffer
ptr Offset
off = do
    Word16
w0 <- (Word16 -> Offset -> Word16
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
8) (Word16 -> Word16) -> (Word8 -> Word16) -> Word8 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> IO Word8 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr Offset
off
    Word16
w1 <-                Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> IO Word8 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> IO Word16) -> Word16 -> IO Word16
forall a b. (a -> b) -> a -> b
$ Word16
w0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
w1
{-# INLINE peek16 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek24
-- 66051
peek24 :: Buffer -> Offset -> IO Word32
peek24 :: Buffer -> Offset -> IO Word32
peek24 Buffer
ptr Offset
off = do
    Word32
w0 <- (Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
16) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr Offset
off
    Word32
w1 <- (Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftL`  Offset
8) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word32
w2 <-                 Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w2
{-# INLINE peek24 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4]
-- >>> unsafeWithByteString buf peek32
-- 16909060
peek32 :: Buffer -> Offset -> IO Word32
peek32 :: Buffer -> Offset -> IO Word32
peek32 Buffer
ptr Offset
off = do
    Word32
w0 <- (Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
24) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr Offset
off
    Word32
w1 <- (Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
16) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word32
w2 <- (Word32 -> Offset -> Word32
forall a. Bits a => a -> Offset -> a
`shiftL`  Offset
8) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
    Word32
w3 <-                 Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
3)
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w3
{-# INLINE peek32 #-}

-- |
--
-- >>> let buf = pack [1,2,3,4,5,6,7,8]
-- >>> unsafeWithByteString buf peek64
-- 72623859790382856
peek64 :: Buffer -> Offset -> IO Word64
peek64 :: Buffer -> Offset -> IO Word64
peek64 Buffer
ptr Offset
off = do
    Word64
w0 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
56) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr Offset
off
    Word64
w1 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
48) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1)
    Word64
w2 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
40) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2)
    Word64
w3 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
32) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
3)
    Word64
w4 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
24) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
4)
    Word64
w5 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL` Offset
16) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
5)
    Word64
w6 <- (Word64 -> Offset -> Word64
forall a. Bits a => a -> Offset -> a
`shiftL`  Offset
8) (Word64 -> Word64) -> (Word8 -> Word64) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
6)
    Word64
w7 <-                 Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO Word8
peek8 Buffer
ptr (Offset
off Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
7)
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64
w0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w5 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w7
{-# INLINE peek64 #-}

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

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

-- |
--
-- >>> let w = 5 :: Word8
-- >>> unpack $ bytestring8 w
-- [5]
bytestring8 :: Word8 -> ByteString
bytestring8 :: Word8 -> ByteString
bytestring8 Word8
w = Offset -> (Buffer -> IO ()) -> ByteString
unsafeCreate Offset
1 ((Buffer -> IO ()) -> ByteString)
-> (Buffer -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> Word8 -> Buffer -> Offset -> IO ()
poke8 Word8
w Buffer
ptr Offset
0
{-# INLINE bytestring8 #-}

-- |
--
-- >>> 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 = Offset -> (Buffer -> IO ()) -> ByteString
unsafeCreate Offset
2 ((Buffer -> IO ()) -> ByteString)
-> (Buffer -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> Word16 -> Buffer -> Offset -> IO ()
poke16 Word16
w Buffer
ptr Offset
0
{-# INLINE bytestring16 #-}

-- |
--
-- >>> 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 = Offset -> (Buffer -> IO ()) -> ByteString
unsafeCreate Offset
4 ((Buffer -> IO ()) -> ByteString)
-> (Buffer -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> Word32 -> Buffer -> Offset -> IO ()
poke32 Word32
w Buffer
ptr Offset
0
{-# INLINE bytestring32 #-}

-- |
--
-- >>> 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 = Offset -> (Buffer -> IO ()) -> ByteString
unsafeCreate Offset
8 ((Buffer -> IO ()) -> ByteString)
-> (Buffer -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> Word64 -> Buffer -> Offset -> IO ()
poke64 Word64
w Buffer
ptr Offset
0
{-# INLINE bytestring64 #-}

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

-- |
--
-- >>> 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 -> (Buffer -> Offset -> IO Word8) -> IO Word8
forall a. ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString ByteString
bs Buffer -> Offset -> IO Word8
peek8
{-# NOINLINE word8 #-}

-- |
--
-- >>> 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 -> (Buffer -> Offset -> IO Word16) -> IO Word16
forall a. ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString ByteString
bs Buffer -> Offset -> IO Word16
peek16
{-# NOINLINE word16 #-}

-- |
--
-- >>> 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 -> (Buffer -> Offset -> IO Word32) -> IO Word32
forall a. ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString ByteString
bs Buffer -> Offset -> IO Word32
peek32
{-# NOINLINE word32 #-}

-- |
--
-- >>> 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 -> (Buffer -> Offset -> IO Word64) -> IO Word64
forall a. ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString ByteString
bs Buffer -> Offset -> IO Word64
peek64
{-# NOINLINE word64 #-}

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

-- | 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 :: ByteString -> (Buffer -> Offset -> IO a) -> IO a
unsafeWithByteString (PS ForeignPtr Word8
fptr Offset
off Offset
_) Buffer -> Offset -> IO a
io = ForeignPtr Word8 -> (Buffer -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Buffer -> IO a) -> IO a) -> (Buffer -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \Buffer
ptr -> Buffer -> Offset -> IO a
io Buffer
ptr Offset
off

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

-- | 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 :: Buffer -> Offset -> (ByteString -> IO a) -> IO a
bufferIO Buffer
ptr Offset
siz ByteString -> IO a
io = do
    ForeignPtr Word8
fptr <- Buffer -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Buffer
ptr
    ByteString -> IO a
io (ByteString -> IO a) -> ByteString -> IO a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Offset -> Offset -> ByteString
PS ForeignPtr Word8
fptr Offset
0 Offset
siz

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

-- | Read and write buffer.
data WriteBuffer = WriteBuffer {
    WriteBuffer -> Buffer
start :: Buffer
  , WriteBuffer -> Buffer
limit :: Buffer
  , WriteBuffer -> IORef Buffer
offset :: IORef Buffer
  , WriteBuffer -> IORef Buffer
oldoffset :: IORef Buffer
  }

-- | Creating a write buffer with the given buffer.
newWriteBuffer :: Buffer -> BufferSize -> IO WriteBuffer
newWriteBuffer :: Buffer -> Offset -> IO WriteBuffer
newWriteBuffer Buffer
buf Offset
siz =
    Buffer -> Buffer -> IORef Buffer -> IORef Buffer -> WriteBuffer
WriteBuffer Buffer
buf (Buffer
buf Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
siz) (IORef Buffer -> IORef Buffer -> WriteBuffer)
-> IO (IORef Buffer) -> IO (IORef Buffer -> WriteBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> IO (IORef Buffer)
forall a. a -> IO (IORef a)
newIORef Buffer
buf IO (IORef Buffer -> WriteBuffer)
-> IO (IORef Buffer) -> IO WriteBuffer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Buffer -> IO (IORef Buffer)
forall a. a -> IO (IORef a)
newIORef Buffer
buf

-- | Reseting a write buffer.
clearWriteBuffer :: WriteBuffer -> IO ()
clearWriteBuffer :: WriteBuffer -> IO ()
clearWriteBuffer WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} = do
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
start
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
oldoffset Buffer
start

-- | 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{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Word8
w = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Buffer -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Buffer
ptr Word8
w
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
{-# INLINE write8 #-}

-- | 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{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Word16
w = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
2
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word16 -> Buffer -> Offset -> IO ()
poke16 Word16
w Buffer
ptr Offset
0
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
{-# INLINE write16 #-}

-- | Write three bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 3 $ \wbuf -> write24 wbuf (65 * 256^2 + 66 * 256 + 67)
-- "ABC"
write24 :: WriteBuffer -> Word32 -> IO ()
write24 :: WriteBuffer -> Word32 -> IO ()
write24 WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Word32
w = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
3
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Buffer -> Offset -> IO ()
poke24 Word32
w Buffer
ptr Offset
0
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
{-# INLINE write24 #-}

-- | Write four bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
--
-- >>> withWriteBuffer 4 $ \wbuf -> write32 wbuf (65 * 256^3 + 66 * 256^2 + 67 * 256 + 68)
-- "ABCD"
write32 :: WriteBuffer -> Word32 -> IO ()
write32 :: WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Word32
w = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
4
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word32 -> Buffer -> Offset -> IO ()
poke32 Word32
w Buffer
ptr Offset
0
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
{-# INLINE write32 #-}

-- | Write four bytes and ff one byte.
--   If buffer overrun occurs, 'BufferOverrun' is thrown.
write64 :: WriteBuffer -> Word64 -> IO ()
write64 :: WriteBuffer -> Word64 -> IO ()
write64 WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Word64
w = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
8
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Word64 -> Buffer -> Offset -> IO ()
poke64 Word64
w Buffer
ptr Offset
0
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
{-# INLINE write64 #-}

-- | 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 -> Offset -> Offset -> IO ()
shiftLastN WriteBuffer
_ Offset
0 Offset
_   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shiftLastN WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} Offset
i Offset
len = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let ptr' :: Ptr b
ptr' = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
i
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
ptr' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
>= Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    if Offset
i Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Offset
0 then do
        let src :: Ptr b
src = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset -> Offset
forall a. Num a => a -> a
negate Offset
len
            dst :: Ptr b
dst = Ptr Any
forall b. Ptr b
src Ptr Any -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
i
        Buffer -> Buffer -> Offset -> IO ()
shiftLeft Buffer
forall b. Ptr b
dst Buffer
forall b. Ptr b
src Offset
len
        IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
      else do
        let src :: Ptr b
src = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` (-Offset
1)
            dst :: Ptr b
dst = Ptr Any
forall b. Ptr b
ptr' Ptr Any -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` (-Offset
1)
        Buffer -> Buffer -> Offset -> IO ()
shiftRight Buffer
forall b. Ptr b
dst Buffer
forall b. Ptr b
src Offset
len
        IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
ptr'
  where
    -- memcpy cannot be used for overlapped areas.
    shiftLeft :: Buffer -> Buffer -> Int -> IO ()
    shiftLeft :: Buffer -> Buffer -> Offset -> IO ()
shiftLeft Buffer
_    Buffer
_    Offset
0   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    shiftLeft Buffer
dst Buffer
src Offset
n = do
        Buffer -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Buffer
src IO Word8 -> (Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Buffer -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Buffer
dst
        Buffer -> Buffer -> Offset -> IO ()
shiftLeft (Buffer
dst Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
1) (Buffer
src Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
1) (Offset
n Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
1)
    shiftRight :: Buffer -> Buffer -> Int -> IO ()
    shiftRight :: Buffer -> Buffer -> Offset -> IO ()
shiftRight Buffer
_    Buffer
_    Offset
0   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    shiftRight Buffer
dst Buffer
src Offset
n = do
        Buffer -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Buffer
src IO Word8 -> (Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Buffer -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Buffer
dst
        Buffer -> Buffer -> Offset -> IO ()
shiftRight (Buffer
dst Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` (-Offset
1)) (Buffer
src Buffer -> Offset -> Buffer
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` (-Offset
1)) (Offset
n Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
1)
{-# INLINE shiftLastN #-}

-- | 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{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} (PS ForeignPtr Word8
fptr Offset
off Offset
len) = ForeignPtr Word8 -> (Buffer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Buffer -> IO ()) -> IO ()) -> (Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> do
    let src :: Ptr b
src = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
off
    Buffer
dst <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let dst' :: Ptr b
dst' = Buffer
dst Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
dst' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    Buffer -> Buffer -> Offset -> IO ()
memcpy Buffer
dst Buffer
forall b. Ptr b
src Offset
len
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
dst'
{-# INLINE copyByteString #-}

-- | 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{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} ShortByteString
sbs = do
    Buffer
dst <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let len :: Offset
len = ShortByteString -> Offset
Short.length ShortByteString
sbs
    let dst' :: Ptr b
dst' = Buffer
dst Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer
forall b. Ptr b
dst' Buffer -> Buffer -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer
limit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferOverrun -> IO ()
forall e a. Exception e => e -> IO a
throwIO BufferOverrun
BufferOverrun
    ShortByteString -> Offset -> Buffer -> Offset -> IO ()
forall a. ShortByteString -> Offset -> Ptr a -> Offset -> IO ()
Short.copyToPtr ShortByteString
sbs Offset
0 Buffer
dst Offset
len
    IORef Buffer -> Buffer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Buffer
offset Buffer
forall b. Ptr b
dst'
{-# INLINE copyShortByteString #-}

-- | Copy the area from 'start' to the current pointer to 'ByteString'.
toByteString :: WriteBuffer -> IO ByteString
toByteString :: WriteBuffer -> IO ByteString
toByteString WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let len :: Offset
len = Buffer
ptr Buffer -> Buffer -> Offset
forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Buffer
start
    Offset -> (Buffer -> IO ()) -> IO ByteString
create Offset
len ((Buffer -> IO ()) -> IO ByteString)
-> (Buffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
p -> Buffer -> Buffer -> Offset -> IO ()
memcpy Buffer
p Buffer
start Offset
len
{-# INLINE toByteString #-}

-- | Copy the area from 'start' to the current pointer to 'ShortByteString'.
toShortByteString :: WriteBuffer -> IO ShortByteString
toShortByteString :: WriteBuffer -> IO ShortByteString
toShortByteString WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} = do
    Buffer
ptr <- IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
    let len :: Offset
len = Buffer
ptr Buffer -> Buffer -> Offset
forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Buffer
start
    Buffer -> Offset -> IO ShortByteString
forall a. Ptr a -> Offset -> IO ShortByteString
Short.createFromPtr Buffer
start Offset
len
{-# INLINE toShortByteString #-}

-- | Allocate a temporary buffer and copy the result to 'ByteString'.
withWriteBuffer :: BufferSize -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer :: Offset -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Offset
siz WriteBuffer -> IO ()
action = IO Buffer
-> (Buffer -> IO ()) -> (Buffer -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Offset -> IO Buffer
forall a. Offset -> IO (Ptr a)
mallocBytes Offset
siz) Buffer -> IO ()
forall a. Ptr a -> IO ()
free ((Buffer -> IO ByteString) -> IO ByteString)
-> (Buffer -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
buf -> do
    WriteBuffer
wbuf <- Buffer -> Offset -> IO WriteBuffer
newWriteBuffer Buffer
buf Offset
siz
    WriteBuffer -> IO ()
action WriteBuffer
wbuf
    WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf

-- | 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' :: Offset -> (WriteBuffer -> IO a) -> IO (ByteString, a)
withWriteBuffer' Offset
siz WriteBuffer -> IO a
action = IO Buffer
-> (Buffer -> IO ())
-> (Buffer -> IO (ByteString, a))
-> IO (ByteString, a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Offset -> IO Buffer
forall a. Offset -> IO (Ptr a)
mallocBytes Offset
siz) Buffer -> IO ()
forall a. Ptr a -> IO ()
free ((Buffer -> IO (ByteString, a)) -> IO (ByteString, a))
-> (Buffer -> IO (ByteString, a)) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \Buffer
buf -> do
    WriteBuffer
wbuf <- Buffer -> Offset -> IO WriteBuffer
newWriteBuffer Buffer
buf Offset
siz
    a
x <- WriteBuffer -> IO a
action WriteBuffer
wbuf
    ByteString
bs <- WriteBuffer -> IO ByteString
toByteString WriteBuffer
wbuf
    (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,a
x)

-- | Getting the offset pointer.
currentOffset :: WriteBuffer -> IO Buffer
currentOffset :: WriteBuffer -> IO Buffer
currentOffset WriteBuffer{Buffer
IORef Buffer
oldoffset :: IORef Buffer
offset :: IORef Buffer
limit :: Buffer
start :: Buffer
oldoffset :: WriteBuffer -> IORef Buffer
offset :: WriteBuffer -> IORef Buffer
limit :: WriteBuffer -> Buffer
start :: WriteBuffer -> Buffer
..} = IORef Buffer -> IO Buffer
forall a. IORef a -> IO a
readIORef IORef Buffer
offset
{-# INLINE currentOffset #-}

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

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

instance Readable ReadBuffer where
    {-# INLINE read8 #-}
    read8 :: ReadBuffer -> IO Word8
read8 (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 WriteBuffer
w
    {-# INLINE readInt8 #-}
    readInt8 :: ReadBuffer -> IO Offset
readInt8 (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
readInt8 WriteBuffer
w
    {-# INLINE ff #-}
    ff :: ReadBuffer -> Offset -> IO ()
ff (ReadBuffer WriteBuffer
w) = WriteBuffer -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff WriteBuffer
w
    {-# INLINE remainingSize #-}
    remainingSize :: ReadBuffer -> IO Offset
remainingSize (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
remainingSize WriteBuffer
w
    {-# INLINE withCurrentOffSet #-}
    withCurrentOffSet :: ReadBuffer -> (Buffer -> IO b) -> IO b
withCurrentOffSet (ReadBuffer WriteBuffer
w) = WriteBuffer -> (Buffer -> IO b) -> IO b
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet WriteBuffer
w
    {-# INLINE save #-}
    save :: ReadBuffer -> IO ()
save (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO ()
forall a. Readable a => a -> IO ()
save WriteBuffer
w
    {-# INLINE savingSize #-}
    savingSize :: ReadBuffer -> IO Offset
savingSize (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
savingSize WriteBuffer
w
    {-# INLINE goBack #-}
    goBack :: ReadBuffer -> IO ()
goBack (ReadBuffer WriteBuffer
w) = WriteBuffer -> IO ()
forall a. Readable a => a -> IO ()
goBack WriteBuffer
w

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

-- | 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 :: Buffer -> Offset -> IO ReadBuffer
newReadBuffer Buffer
buf Offset
siz = WriteBuffer -> ReadBuffer
ReadBuffer (WriteBuffer -> ReadBuffer) -> IO WriteBuffer -> IO ReadBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Offset -> IO WriteBuffer
newWriteBuffer Buffer
buf Offset
siz

-- | Converting 'ByteString' to 'ReadBuffer' and run the action
--   with it.
withReadBuffer :: ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer :: ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer (PS ForeignPtr Word8
fp Offset
off Offset
siz) ReadBuffer -> IO a
action = ForeignPtr Word8 -> (Buffer -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Buffer -> IO a) -> IO a) -> (Buffer -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Buffer
ptr -> do
    let buf :: Ptr b
buf = Buffer
ptr Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
off
    ReadBuffer
nsrc <- Buffer -> Offset -> IO ReadBuffer
newReadBuffer Buffer
forall b. Ptr b
buf Offset
siz
    ReadBuffer -> IO a
action ReadBuffer
nsrc

-- | 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 :: a -> Offset -> IO ByteString
extractByteString a
rbuf Offset
len
  | Offset
len Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Offset
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
  | Offset
len Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
>  Offset
0 = do
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
checkR a
rbuf Offset
len
    ByteString
bs <- a -> (Buffer -> IO ByteString) -> IO ByteString
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Buffer -> IO ByteString) -> IO ByteString)
-> (Buffer -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
src ->
        Offset -> (Buffer -> IO ()) -> IO ByteString
create Offset
len ((Buffer -> IO ()) -> IO ByteString)
-> (Buffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
dst -> Buffer -> Buffer -> Offset -> IO ()
memcpy Buffer
dst Buffer
src Offset
len
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff a
rbuf Offset
len
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  | Bool
otherwise = a -> (Buffer -> IO ByteString) -> IO ByteString
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf ((Buffer -> IO ByteString) -> IO ByteString)
-> (Buffer -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
src0 -> do
      let src :: Ptr b
src = Buffer
src0 Buffer -> Offset -> Ptr b
forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
      let len' :: Offset
len' = Offset -> Offset
forall a. Num a => a -> a
negate Offset
len
      Offset -> (Buffer -> IO ()) -> IO ByteString
create Offset
len' ((Buffer -> IO ()) -> IO ByteString)
-> (Buffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
dst -> Buffer -> Buffer -> Offset -> IO ()
memcpy Buffer
dst Buffer
forall b. Ptr b
src Offset
len'
{-# INLINE extractByteString #-}

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

-- | Reading two bytes as 'Word16' and ff two bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read16
-- 1
read16 :: Readable a => a -> IO Word16
read16 :: a -> IO Word16
read16 a
rbuf = do
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
checkR a
rbuf Offset
2
    Word16
w16 <- a -> (Buffer -> IO Word16) -> IO Word16
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf (Buffer -> Offset -> IO Word16
`peek16` Offset
0)
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff a
rbuf Offset
2
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w16
{-# INLINE read16 #-}

-- | Reading three bytes as 'Word32' and ff three bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read24
-- 258
read24 :: Readable a => a -> IO Word32
read24 :: a -> IO Word32
read24 a
rbuf = do
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
checkR a
rbuf Offset
3
    Word32
w24 <- a -> (Buffer -> IO Word32) -> IO Word32
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf (Buffer -> Offset -> IO Word32
`peek24` Offset
0)
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff a
rbuf Offset
3
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w24
{-# INLINE read24 #-}

-- | Reading four bytes as 'Word32' and ff four bytes.
--
-- >>> withReadBuffer "\x0\x1\x2\x3" $ read32
-- 66051
read32 :: Readable a => a -> IO Word32
read32 :: a -> IO Word32
read32 a
rbuf = do
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
checkR a
rbuf Offset
4
    Word32
w32 <- a -> (Buffer -> IO Word32) -> IO Word32
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf (Buffer -> Offset -> IO Word32
`peek32` Offset
0)
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff a
rbuf Offset
4
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w32
{-# INLINE read32 #-}

-- | Reading four bytes as 'Word64' and ff four bytes.
read64 :: Readable a => a -> IO Word64
read64 :: a -> IO Word64
read64 a
rbuf = do
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
checkR a
rbuf Offset
8
    Word64
w64 <- a -> (Buffer -> IO Word64) -> IO Word64
forall a b. Readable a => a -> (Buffer -> IO b) -> IO b
withCurrentOffSet a
rbuf (Buffer -> Offset -> IO Word64
`peek64` Offset
0)
    a -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff a
rbuf Offset
8
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w64
{-# INLINE read64 #-}

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

-- | 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
/= :: BufferOverrun -> BufferOverrun -> Bool
$c/= :: BufferOverrun -> BufferOverrun -> Bool
== :: BufferOverrun -> BufferOverrun -> Bool
$c== :: BufferOverrun -> BufferOverrun -> Bool
Eq,Offset -> BufferOverrun -> ShowS
[BufferOverrun] -> ShowS
BufferOverrun -> String
(Offset -> BufferOverrun -> ShowS)
-> (BufferOverrun -> String)
-> ([BufferOverrun] -> ShowS)
-> Show BufferOverrun
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferOverrun] -> ShowS
$cshowList :: [BufferOverrun] -> ShowS
show :: BufferOverrun -> String
$cshow :: BufferOverrun -> String
showsPrec :: Offset -> BufferOverrun -> ShowS
$cshowsPrec :: Offset -> BufferOverrun -> ShowS
Show,Typeable)

instance Exception BufferOverrun