{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- | Copyright : (c) 2010      Jasper Van der Jeugt
--               (c) 2010-2011 Simon Meier
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Simon Meier <iridcode@gmail.com>
-- Portability : GHC
--
-- Extra functions for creating and executing 'Builder's. They are intended
-- for application-specific fine-tuning the performance of 'Builder's.
--
-----------------------------------------------------------------------------
module Data.ByteString.Builder.Extra
    (
    -- * Execution strategies
      toLazyByteStringWith
    , AllocationStrategy
    , safeStrategy
    , untrimmedStrategy
    , smallChunkSize
    , defaultChunkSize

    -- * Controlling chunk boundaries
    , byteStringCopy
    , byteStringInsert
    , byteStringThreshold

    , lazyByteStringCopy
    , lazyByteStringInsert
    , lazyByteStringThreshold

    , flush

    -- * Low level execution
    , BufferWriter
    , Next(..)
    , runBuilder

    -- * Host-specific binary encodings
    , intHost
    , int16Host
    , int32Host
    , int64Host

    , wordHost
    , word16Host
    , word32Host
    , word64Host

    , floatHost
    , doubleHost

    ) where


import Data.ByteString.Builder.Internal
         ( Builder, toLazyByteStringWith
         , AllocationStrategy, safeStrategy, untrimmedStrategy
         , smallChunkSize, defaultChunkSize, flush
         , byteStringCopy, byteStringInsert, byteStringThreshold
         , lazyByteStringCopy, lazyByteStringInsert, lazyByteStringThreshold )

import qualified Data.ByteString.Builder.Internal as I
import qualified Data.ByteString.Builder.Prim  as P
import qualified Data.ByteString.Internal      as S

import Foreign

------------------------------------------------------------------------------
-- Builder execution public API
------------------------------------------------------------------------------

-- | A 'BufferWriter' represents the result of running a 'Builder'.
-- It unfolds as a sequence of chunks of data. These chunks come in two forms:
--
--  * an IO action for writing the Builder's data into a user-supplied memory
--    buffer.
--
--  * a pre-existing chunks of data represented by a 'S.StrictByteString'
--
-- While this is rather low level, it provides you with full flexibility in
-- how the data is written out.
--
-- The 'BufferWriter' itself is an IO action: you supply it with a buffer
-- (as a pointer and length) and it will write data into the buffer.
-- It returns a number indicating how many bytes were actually written
-- (which can be @0@). It also returns a 'Next' which describes what
-- comes next.
--
type BufferWriter = Ptr Word8 -> Int -> IO (Int, Next)

-- | After running a 'BufferWriter' action there are three possibilities for
-- what comes next:
--
data Next =
     -- | This means we're all done. All the builder data has now been written.
     Done

     -- | This indicates that there may be more data to write. It
     -- gives you the next 'BufferWriter' action. You should call that action
     -- with an appropriate buffer. The int indicates the /minimum/ buffer size
     -- required by the next 'BufferWriter' action. That is, if you call the next
     -- action you /must/ supply it with a buffer length of at least this size.
   | More   !Int          BufferWriter

     -- | In addition to the data that has just been written into your buffer
     -- by the 'BufferWriter' action, it gives you a pre-existing chunk
     -- of data as a 'S.StrictByteString'. It also gives you the following 'BufferWriter'
     -- action. It is safe to run this following action using a buffer with as
     -- much free space as was left by the previous run action.
   | Chunk  !S.StrictByteString BufferWriter

-- | Turn a 'Builder' into its initial 'BufferWriter' action.
--
runBuilder :: Builder -> BufferWriter
runBuilder :: Builder -> BufferWriter
runBuilder = BuildStep () -> BufferWriter
run (BuildStep () -> BufferWriter)
-> (Builder -> BuildStep ()) -> Builder -> BufferWriter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> BuildStep ()
I.runBuilder
  where
    bytesWritten :: Ptr b -> Ptr a -> Int
bytesWritten Ptr b
startPtr Ptr a
endPtr = Ptr a
endPtr Ptr a -> Ptr b -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
startPtr

    run :: I.BuildStep () -> BufferWriter
    run :: BuildStep () -> BufferWriter
run BuildStep ()
step = \Ptr Word8
buf Int
len ->
      let doneH :: Ptr a -> () -> m (Int, Next)
doneH Ptr a
endPtr () =
            let !wc :: Int
wc  = Ptr Word8 -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
bytesWritten Ptr Word8
buf Ptr a
endPtr
                next :: Next
next = Next
Done
             in (Int, Next) -> m (Int, Next)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wc, Next
next)

          bufferFullH :: Ptr a -> Int -> BuildStep () -> m (Int, Next)
bufferFullH Ptr a
endPtr Int
minReq BuildStep ()
step' =
            let !wc :: Int
wc  = Ptr Word8 -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
bytesWritten Ptr Word8
buf Ptr a
endPtr
                next :: Next
next = Int -> BufferWriter -> Next
More Int
minReq (BuildStep () -> BufferWriter
run BuildStep ()
step')
             in (Int, Next) -> m (Int, Next)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wc, Next
next)

          insertChunkH :: Ptr a -> ByteString -> BuildStep () -> m (Int, Next)
insertChunkH Ptr a
endPtr ByteString
bs BuildStep ()
step' =
            let !wc :: Int
wc  = Ptr Word8 -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
bytesWritten Ptr Word8
buf Ptr a
endPtr
                next :: Next
next = ByteString -> BufferWriter -> Next
Chunk ByteString
bs (BuildStep () -> BufferWriter
run BuildStep ()
step')
             in (Int, Next) -> m (Int, Next)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wc, Next
next)

          br :: BufferRange
br = Ptr Word8 -> Ptr Word8 -> BufferRange
I.BufferRange Ptr Word8
buf (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)

      in BuildStep ()
-> (Ptr Word8 -> () -> IO (Int, Next))
-> (Ptr Word8 -> Int -> BuildStep () -> IO (Int, Next))
-> (Ptr Word8 -> ByteString -> BuildStep () -> IO (Int, Next))
-> BufferRange
-> IO (Int, Next)
forall a b.
BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> ByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
I.fillWithBuildStep BuildStep ()
step Ptr Word8 -> () -> IO (Int, Next)
forall {m :: * -> *} {a}. Monad m => Ptr a -> () -> m (Int, Next)
doneH Ptr Word8 -> Int -> BuildStep () -> IO (Int, Next)
forall {m :: * -> *} {a}.
Monad m =>
Ptr a -> Int -> BuildStep () -> m (Int, Next)
bufferFullH Ptr Word8 -> ByteString -> BuildStep () -> IO (Int, Next)
forall {m :: * -> *} {a}.
Monad m =>
Ptr a -> ByteString -> BuildStep () -> m (Int, Next)
insertChunkH BufferRange
br



------------------------------------------------------------------------------
-- Host-specific encodings
------------------------------------------------------------------------------

-- | Encode a single native machine 'Int'. The 'Int' is encoded in host order,
-- host endian form, for the machine you're on. On a 64 bit machine the 'Int'
-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way
-- are not portable to different endian or int sized machines, without
-- conversion.
--
{-# INLINE intHost #-}
intHost :: Int -> Builder
intHost :: Int -> Builder
intHost = FixedPrim Int -> Int -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Int
P.intHost

-- | Encode a 'Int16' in native host order and host endianness.
{-# INLINE int16Host #-}
int16Host :: Int16 -> Builder
int16Host :: Int16 -> Builder
int16Host = FixedPrim Int16 -> Int16 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Int16
P.int16Host

-- | Encode a 'Int32' in native host order and host endianness.
{-# INLINE int32Host #-}
int32Host :: Int32 -> Builder
int32Host :: Int32 -> Builder
int32Host = FixedPrim Int32 -> Int32 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Int32
P.int32Host

-- | Encode a 'Int64' in native host order and host endianness.
{-# INLINE int64Host #-}
int64Host :: Int64 -> Builder
int64Host :: Int64 -> Builder
int64Host = FixedPrim Int64 -> Int64 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Int64
P.int64Host

-- | Encode a single native machine 'Word'. The 'Word' is encoded 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 encoded this way
-- are not portable to different endian or word sized machines, without
-- conversion.
--
{-# INLINE wordHost #-}
wordHost :: Word -> Builder
wordHost :: Word -> Builder
wordHost = FixedPrim Word -> Word -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Word
P.wordHost

-- | Encode a 'Word16' in native host order and host endianness.
{-# INLINE word16Host #-}
word16Host :: Word16 -> Builder
word16Host :: Word16 -> Builder
word16Host = FixedPrim Word16 -> Word16 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Word16
P.word16Host

-- | Encode a 'Word32' in native host order and host endianness.
{-# INLINE word32Host #-}
word32Host :: Word32 -> Builder
word32Host :: Word32 -> Builder
word32Host = FixedPrim Word32 -> Word32 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Word32
P.word32Host

-- | Encode a 'Word64' in native host order and host endianness.
{-# INLINE word64Host #-}
word64Host :: Word64 -> Builder
word64Host :: Word64 -> Builder
word64Host = FixedPrim Word64 -> Word64 -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Word64
P.word64Host

-- | Encode a 'Float' in native host order. Values encoded this way are not
-- portable to different endian machines, without conversion.
{-# INLINE floatHost #-}
floatHost :: Float -> Builder
floatHost :: Float -> Builder
floatHost = FixedPrim Float -> Float -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Float
P.floatHost

-- | Encode a 'Double' in native host order.
{-# INLINE doubleHost #-}
doubleHost :: Double -> Builder
doubleHost :: Double -> Builder
doubleHost = FixedPrim Double -> Double -> Builder
forall a. FixedPrim a -> a -> Builder
P.primFixed FixedPrim Double
P.doubleHost