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

-- |

-- Module      : Data.ByteString.Builder

-- Copyright   : Lennart Kolmodin, Ross Paterson, George Giorgidze

-- License     : BSD3

--

-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>

-- Stability   : experimental

-- Portability : Portable

--

-- Efficient construction of lazy bytestrings.

--

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

module Codec.ByteString.Builder (

    -- * The Builder type

      Builder
    , toLazyByteString

    -- * Constructing Builders

    , empty
    , singleton
    , putWord8
    , putInt8
    , append
    , fromByteString        -- :: S.ByteString -> Builder

    , fromLazyByteString    -- :: L.ByteString -> Builder

    , putString

    -- * Flushing the buffer state

    , flush

    -- * Derived Builders

    -- ** Big-endian writes

    , putWord16be           -- :: Word16 -> Builder

    , putWord24be           -- :: Word32 -> Builder

    , putWord32be           -- :: Word32 -> Builder

    , putWord64be           -- :: Word64 -> Builder


    , putInt16be           -- :: Int16 -> Builder

    , putInt32be           -- :: Int32 -> Builder

    , putInt64be           -- :: Int64 -> Builder


    -- ** Little-endian writes

    , putWord16le           -- :: Word16 -> Builder

    , putWord24le           -- :: Word32 -> Builder

    , putWord32le           -- :: Word32 -> Builder

    , putWord64le           -- :: Word64 -> Builder


    , putInt16le           -- :: Int16 -> Builder

    , putInt32le           -- :: Int32 -> Builder

    , putInt64le           -- :: Int64 -> Builder


    -- ** Host-endian, unaligned writes

    , putWordHost           -- :: Word -> Builder

    , putWord16host         -- :: Word16 -> Builder

    , putWord32host         -- :: Word32 -> Builder

    , putWord64host         -- :: Word64 -> Builder

    -- Variable length numbers

    , putVarLenBe
    , putVarLenLe

  ) where


import qualified Data.ByteString.Internal as S
import qualified Data.ByteString          as S
import qualified Data.ByteString.Lazy     as L

import Foreign.Storable         (Storable, poke, sizeOf)
import Foreign.Ptr              (Ptr, plusPtr)
import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)
import System.IO.Unsafe         (unsafePerformIO)
import Data.ByteString.Internal (c2w)

import Data.Bits
import Data.Word
import Data.Int
import Data.Semigroup

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


-- | A 'Builder' is an efficient way to build lazy 'L.ByteString's.

-- There are several functions for constructing 'Builder's, but only one

-- to inspect them: to extract any data, you have to turn them into lazy

-- 'L.ByteString's using 'toLazyByteString'.

--

-- Internally, a 'Builder' constructs a lazy 'L.Bytestring' by filling byte

-- arrays piece by piece.  As each buffer is filled, it is \'popped\'

-- off, to become a new chunk of the resulting lazy 'L.ByteString'.

-- All this is hidden from the user of the 'Builder'.


newtype Builder = Builder {
        -- Invariant (from Data.ByteString.Lazy):

        --      The lists include no null ByteStrings.

        Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]
    }

instance Semigroup Builder where
    <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
append

instance Monoid Builder where
    mempty :: Builder
mempty  = Builder
empty
    mappend :: Builder -> Builder -> Builder
mappend = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>)

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


-- | /O(1)./ The empty Builder, satisfying

--

--  * @'toLazyByteString' 'empty' = 'L.empty'@

--

empty :: Builder
empty :: Builder
empty = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
forall a. a -> a
id

-- | /O(1)./ A Builder taking a single byte, satisfying

--

--  * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@

--

singleton :: Word8 -> Builder
singleton :: Word8 -> Builder
singleton = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
1 ((Ptr Word8 -> IO ()) -> Builder)
-> (Word8 -> Ptr Word8 -> IO ()) -> Word8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Word8 -> IO ()) -> Word8 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke

putWord8 :: Word8 -> Builder
putWord8 :: Word8 -> Builder
putWord8 = Word8 -> Builder
singleton
------------------------------------------------------------------------


-- | /O(1)./ The concatenation of two Builders, an associative operation

-- with identity 'empty', satisfying

--

--  * @'toLazyByteString' ('append' x y) = 'L.append' ('toLazyByteString' x) ('toLazyByteString' y)@

--

append :: Builder -> Builder -> Builder
append :: Builder -> Builder -> Builder
append (Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
f) (Builder (Buffer -> [ByteString]) -> Buffer -> [ByteString]
g) = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder ((Buffer -> [ByteString]) -> Buffer -> [ByteString]
f ((Buffer -> [ByteString]) -> Buffer -> [ByteString])
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString])
-> (Buffer -> [ByteString])
-> Buffer
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> [ByteString]) -> Buffer -> [ByteString]
g)

-- | /O(1)./ A Builder taking a 'S.ByteString', satisfying

--

--  * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@

--

fromByteString :: S.ByteString -> Builder
fromByteString :: ByteString -> Builder
fromByteString ByteString
bs
  | ByteString -> Bool
S.null ByteString
bs = Builder
empty
  | Bool
otherwise = Builder
flush Builder -> Builder -> Builder
`append` ([ByteString] -> [ByteString]) -> Builder
mapBuilder (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)

-- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying

--

--  * @'toLazyByteString' ('fromLazyByteString' bs) = bs@

--

fromLazyByteString :: L.ByteString -> Builder
fromLazyByteString :: ByteString -> Builder
fromLazyByteString ByteString
bss = Builder
flush Builder -> Builder -> Builder
`append` ([ByteString] -> [ByteString]) -> Builder
mapBuilder (ByteString -> [ByteString]
L.toChunks ByteString
bss [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++)

putString :: String -> Builder
putString :: String -> Builder
putString = ByteString -> Builder
fromLazyByteString (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
L.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w

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


-- Our internal buffer type

data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
                     {-# UNPACK #-} !Int                -- offset

                     {-# UNPACK #-} !Int                -- used bytes

                     {-# UNPACK #-} !Int                -- length left


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


-- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.

-- The construction work takes place if and when the relevant part of

-- the lazy 'L.ByteString' is demanded.

--

toLazyByteString :: Builder -> L.ByteString
toLazyByteString :: Builder -> ByteString
toLazyByteString Builder
m = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
    Buffer
buf <- Int -> IO Buffer
newBuffer Int
defaultSize
    [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder (Builder
m Builder -> Builder -> Builder
`append` Builder
flush) ([ByteString] -> Buffer -> [ByteString]
forall a b. a -> b -> a
const []) Buffer
buf)

-- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,

-- yielding a new chunk in the result lazy 'L.ByteString'.

flush :: Builder
flush :: Builder
flush = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k buf :: Buffer
buf@(Buffer ForeignPtr Word8
p Int
o Int
u Int
l) ->
    if Int
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Buffer -> [ByteString]
k Buffer
buf
      else ForeignPtr Word8 -> Int -> Int -> ByteString
S.PS ForeignPtr Word8
p Int
o Int
u ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Buffer -> [ByteString]
k (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
p (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u) Int
0 Int
l)

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


--

-- copied from Data.ByteString.Lazy

--

defaultSize :: Int
defaultSize :: Int
defaultSize = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
overhead
    where k :: Int
k = Int
1024
          overhead :: Int
overhead = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)

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


-- | Sequence an IO operation on the buffer

unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder
unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder
unsafeLiftIO Buffer -> IO Buffer
f =  ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k Buffer
buf -> IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
    Buffer
buf' <- Buffer -> IO Buffer
f Buffer
buf
    [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> [ByteString]
k Buffer
buf')

-- | Get the size of the buffer

withSize :: (Int -> Builder) -> Builder
withSize :: (Int -> Builder) -> Builder
withSize Int -> Builder
f = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder (((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder)
-> ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Buffer -> [ByteString]
k buf :: Buffer
buf@(Buffer ForeignPtr Word8
_ Int
_ Int
_ Int
l) ->
    Builder -> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
runBuilder (Int -> Builder
f Int
l) Buffer -> [ByteString]
k Buffer
buf

-- | Map the resulting list of bytestrings.

mapBuilder :: ([S.ByteString] -> [S.ByteString]) -> Builder
mapBuilder :: ([ByteString] -> [ByteString]) -> Builder
mapBuilder [ByteString] -> [ByteString]
f = ((Buffer -> [ByteString]) -> Buffer -> [ByteString]) -> Builder
Builder ([ByteString] -> [ByteString]
f ([ByteString] -> [ByteString])
-> (Buffer -> [ByteString]) -> Buffer -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

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


-- | Ensure that there are at least @n@ many bytes available.

ensureFree :: Int -> Builder
ensureFree :: Int -> Builder
ensureFree Int
n = Int
n Int -> Builder -> Builder
`seq` (Int -> Builder) -> Builder
withSize ((Int -> Builder) -> Builder) -> (Int -> Builder) -> Builder
forall a b. (a -> b) -> a -> b
$ \ Int
l ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l then Builder
empty else
        Builder
flush Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (IO Buffer -> Buffer -> IO Buffer
forall a b. a -> b -> a
const (Int -> IO Buffer
newBuffer (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
defaultSize)))

-- | Ensure that @n@ many bytes are available, and then use @f@ to write some

-- bytes into the memory.

writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
n Ptr Word8 -> IO ()
f = Int -> Builder
ensureFree Int
n Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer Int
n Ptr Word8 -> IO ()
f)

writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer
writeNBuffer Int
n Ptr Word8 -> IO ()
f (Buffer ForeignPtr Word8
fp Int
o Int
u Int
l) = do
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr Word8 -> IO ()
f (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u)))
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
o (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))

newBuffer :: Int -> IO Buffer
newBuffer :: Int -> IO Buffer
newBuffer Int
size = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
size
    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
$! ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
0 Int
0 Int
size

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

-- Aligned, host order writes of storable values


-- | Ensure that @n@ many bytes are available, and then use @f@ to write some

-- storable values into the memory.

writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes :: Int -> (Ptr a -> IO ()) -> Builder
writeNbytes Int
n Ptr a -> IO ()
f = Int -> Builder
ensureFree Int
n Builder -> Builder -> Builder
`append` (Buffer -> IO Buffer) -> Builder
unsafeLiftIO (Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
forall a.
Storable a =>
Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes Int
n Ptr a -> IO ()
f)

writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes :: Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer
writeNBufferBytes Int
n Ptr a -> IO ()
f (Buffer ForeignPtr Word8
fp Int
o Int
u Int
l) = do
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Ptr a -> IO ()
f (Ptr Word8
p Ptr Word8 -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u)))
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> Int -> Buffer
Buffer ForeignPtr Word8
fp Int
o (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))

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


--

-- We rely on the fromIntegral to do the right masking for us.

-- The inlining here is critical, and can be worth 4x performance

--


-- | Write a Word16 in big endian format

putWord16be :: Word16 -> Builder
putWord16be :: Word16 -> Builder
putWord16be Word16
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
2 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
w Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w)              :: Word8)

-- | Write a Word16 in little endian format

putWord16le :: Word16 -> Builder
putWord16le :: Word16 -> Builder
putWord16le Word16
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
2 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w)              :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
w Int
8) :: Word8)

-- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)


-- | Write a 24 bit number in big endian format represented as Word32

putWord24be :: Word32 -> Builder
putWord24be :: Word32 -> Builder
putWord24be Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
3 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w) :: Word8)

-- | Write a 24 bit number in little endian format represented as Word32

putWord24le :: Word32 -> Builder
putWord24le :: Word32 -> Builder
putWord24le Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
3 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w)           :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w  Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8)

-- | Write a Word32 in big endian format

putWord32be :: Word32 -> Builder
putWord32be :: Word32 -> Builder
putWord32be Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
4 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w  Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w)           :: Word8)

--

-- a data type to tag Put/Check. writes construct these which are then

-- inlined and flattened. matching Checks will be more robust with rules.

--


-- | Write a Word32 in little endian format

putWord32le :: Word32 -> Builder
putWord32le :: Word32 -> Builder
putWord32le Word32
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
4 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w)               :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w  Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8)

-- on a little endian machine:

-- putWord32le w32 = writeN 4 (\p -> poke (castPtr p) w32)


-- | Write a Word64 in big endian format

putWord64be :: Word64 -> Builder
putWord64be :: Word64 -> Builder
putWord64be Word64
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
8 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
56) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
48) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
40) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
32) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
24) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
16) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w  Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w)               :: Word8)

-- | Write a Word64 in little endian format

putWord64le :: Word64 -> Builder
putWord64le :: Word64 -> Builder
putWord64le Word64
w = Int -> (Ptr Word8 -> IO ()) -> Builder
writeN Int
8 ((Ptr Word8 -> IO ()) -> Builder)
-> (Ptr Word8 -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p               (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w)               :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w  Int
8) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
16) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
24) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
32) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
40) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
48) :: Word8)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
56) :: Word8)

-- on a little endian machine:

-- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)


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


putInt8 :: Int8 -> Builder
putInt8 :: Int8 -> Builder
putInt8 = Word8 -> Builder
putWord8 (Word8 -> Builder) -> (Int8 -> Word8) -> Int8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt16le :: Int16 -> Builder
putInt16le :: Int16 -> Builder
putInt16le = Word16 -> Builder
putWord16le (Word16 -> Builder) -> (Int16 -> Word16) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt16be :: Int16 -> Builder
putInt16be :: Int16 -> Builder
putInt16be = Word16 -> Builder
putWord16be (Word16 -> Builder) -> (Int16 -> Word16) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt32le :: Int32 -> Builder
putInt32le :: Int32 -> Builder
putInt32le = Word32 -> Builder
putWord32le (Word32 -> Builder) -> (Int32 -> Word32) -> Int32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt32be :: Int32 -> Builder
putInt32be :: Int32 -> Builder
putInt32be = Word32 -> Builder
putWord32be (Word32 -> Builder) -> (Int32 -> Word32) -> Int32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt64le :: Int64 -> Builder
putInt64le :: Int64 -> Builder
putInt64le = Word64 -> Builder
putWord64le (Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

putInt64be :: Int64 -> Builder
putInt64be :: Int64 -> Builder
putInt64be = Word64 -> Builder
putWord64be (Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

-- Unaligned, word size ops


-- | /O(1)./ A Builder taking a single native machine word. The word is

-- written in host order, host endian form, for the machine you're on.

-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,

-- 4 bytes. Values written this way are not portable to

-- different endian or word sized machines, without conversion.

--

putWordHost :: Word -> Builder
putWordHost :: Word -> Builder
putWordHost Word
w = Int -> (Ptr Word -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)) (\Ptr Word
p -> Ptr Word -> Word -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word
p Word
w)

-- | Write a Word16 in native host order and host endianness.

-- 2 bytes will be written, unaligned.

putWord16host :: Word16 -> Builder
putWord16host :: Word16 -> Builder
putWord16host Word16
w16 = Int -> (Ptr Word16 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word16 -> Int
forall a. Storable a => a -> Int
sizeOf (Word16
forall a. HasCallStack => a
undefined :: Word16)) (\Ptr Word16
p -> Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
p Word16
w16)

-- | Write a Word32 in native host order and host endianness.

-- 4 bytes will be written, unaligned.

putWord32host :: Word32 -> Builder
putWord32host :: Word32 -> Builder
putWord32host Word32
w32 = Int -> (Ptr Word32 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32)) (\Ptr Word32
p -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
p Word32
w32)

-- | Write a Word64 in native host order.

-- On a 32 bit machine we write two host order Word32s, in big endian form.

-- 8 bytes will be written, unaligned.

putWord64host :: Word64 -> Builder
putWord64host :: Word64 -> Builder
putWord64host Word64
w = Int -> (Ptr Word64 -> IO ()) -> Builder
forall a. Storable a => Int -> (Ptr a -> IO ()) -> Builder
writeNbytes (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64)) (\Ptr Word64
p -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
p Word64
w)

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


putVarLenBe :: Word64 -> Builder
putVarLenBe :: Word64 -> Builder
putVarLenBe Word64
w = [Word8] -> Builder
varLenAux2 ([Word8] -> Builder) -> [Word8] -> Builder
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word8]
varLenAux1 Word64
w
  
putVarLenLe :: Word64 -> Builder
putVarLenLe :: Word64 -> Builder
putVarLenLe Word64
w = [Word8] -> Builder
varLenAux2 ([Word8] -> Builder) -> [Word8] -> Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word8]
varLenAux1 Word64
w
  
varLenAux1 :: Word64 -> [Word8]
varLenAux1 :: Word64 -> [Word8]
varLenAux1 Word64
0 = []
varLenAux1 Word64
w = (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7F) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (Word64 -> [Word8]
varLenAux1 (Word64 -> [Word8]) -> Word64 -> [Word8]
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
7)

varLenAux2 :: [Word8] -> Builder
varLenAux2 :: [Word8] -> Builder
varLenAux2  [] = Word8 -> Builder
putWord8 Word8
0
varLenAux2  [Word8
w] = Word8 -> Builder
putWord8 Word8
w
varLenAux2 (Word8
w : [Word8]
ws) = Word8 -> Builder
putWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Word8
w Int
7) Builder -> Builder -> Builder
`append` [Word8] -> Builder
varLenAux2 [Word8]
ws