    {-# LANGUAGE CPP, BangPatterns, Rank2Types #-}

    #ifdef USE_MONO_PAT_BINDS
    {-# LANGUAGE MonoPatBinds #-}
    #endif

    -- |
    -- Module      : Blaze.ByteString.Builder.Internal.Buffer
    -- Copyright   : (c) 2010 Simon Meier
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Simon Meier <iridcode@gmail.com>
    -- Stability   : experimental
    -- Portability : tested on GHC only
    --
    -- Execution of the 'Put' monad and hence also 'Builder's with respect to
    -- buffers.
    --
    module Blaze.ByteString.Builder.Internal.Buffer (
      -- * Buffers
        Buffer (..)

      -- ** Status information
      , freeSize
      , sliceSize
      , bufferSize

      -- ** Creation and modification
      , allocBuffer
      , reuseBuffer
      , nextSlice
      , updateEndOfSlice
      , execBuildStep

      -- ** Conversion to bytestings
      , unsafeFreezeBuffer
      , unsafeFreezeNonEmptyBuffer

      -- * Buffer allocation strategies
      , BufferAllocStrategy
      , allNewBuffersStrategy
      , reuseBufferStrategy

      -- * Executing puts respect to some monad
      , runPut
      ) where

    #ifdef HAS_FOREIGN_UNSAFE_MODULE
    import Foreign                   (Word8, ForeignPtr, Ptr, plusPtr, minusPtr)
    import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
    #else
    import Foreign                   (unsafeForeignPtrToPtr, Word8, ForeignPtr, Ptr, plusPtr, minusPtr)
    #endif

    import qualified Data.ByteString      as S

    #ifdef BYTESTRING_IN_BASE
    import qualified Data.ByteString.Base as S
    #else
    import qualified Data.ByteString.Internal as S
    #endif

    import Blaze.ByteString.Builder.Internal.Types
    ------------------------------------------------------------------------------
    -- Buffers
    ------------------------------------------------------------------------------

    -- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying
    -- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free
    -- space @op..ope@.
    data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array
                         {-# UNPACK #-} !(Ptr Word8)        -- beginning of slice
                         {-# UNPACK #-} !(Ptr Word8)        -- next free byte
                         {-# UNPACK #-} !(Ptr Word8)        -- first byte after buffer

    -- | The size of the free space of the buffer.
    freeSize :: Buffer -> Int
    freeSize (Buffer _ _ op ope) = ope `minusPtr` op

    -- | The size of the written slice in the buffer.
    sliceSize :: Buffer -> Int
    sliceSize (Buffer _ p0 op _) = op `minusPtr` p0

    -- | The size of the whole byte array underlying the buffer.
    bufferSize :: Buffer -> Int
    bufferSize (Buffer fpbuf _ _ ope) =
        ope `minusPtr` unsafeForeignPtrToPtr fpbuf

    -- | @allocBuffer size@ allocates a new buffer of size @size@.
    {-# INLINE allocBuffer #-}
    allocBuffer :: Int -> IO Buffer
    allocBuffer size = do
        fpbuf <- S.mallocByteString size
        let !pbuf = unsafeForeignPtrToPtr fpbuf
        return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size)

    -- | Resets the beginning of the next slice and the next free byte such that
    -- the whole buffer can be filled again.
    {-# INLINE reuseBuffer #-}
    reuseBuffer :: Buffer -> Buffer
    reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope
      where
        p0 = unsafeForeignPtrToPtr fpbuf

    -- | Convert the buffer to a bytestring. This operation is unsafe in the sense
    -- that created bytestring shares the underlying byte array with the buffer.
    -- Hence, depending on the later use of this buffer (e.g., if it gets reset and
    -- filled again) referential transparency may be lost.
    {-# INLINE unsafeFreezeBuffer #-}
    unsafeFreezeBuffer :: Buffer -> S.ByteString
    unsafeFreezeBuffer (Buffer fpbuf p0 op _) =
        S.PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0)

    -- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for
    -- the explanation of why this operation may be unsafe.
    {-# INLINE unsafeFreezeNonEmptyBuffer #-}
    unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString
    unsafeFreezeNonEmptyBuffer buf
      | sliceSize buf <= 0 = Nothing
      | otherwise          = Just $ unsafeFreezeBuffer buf

    -- | Update the end of slice pointer.
    {-# INLINE updateEndOfSlice #-}
    updateEndOfSlice :: Buffer    -- Old buffer
                     -> Ptr Word8 -- New end of slice
                     -> Buffer    -- Updated buffer
    updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope

    -- | Execute a build step on the given buffer.
    {-# INLINE execBuildStep #-}
    execBuildStep :: BuildStep a
                  -> Buffer
                  -> IO (BuildSignal a)
    execBuildStep step (Buffer _ _ op ope) = runBuildStep step (BufRange op ope)

    -- | Move the beginning of the slice to the next free byte such that the
    -- remaining free space of the buffer can be filled further. This operation
    -- is safe and can be used to fill the remaining part of the buffer after a
    -- direct insertion of a bytestring or a flush.
    {-# INLINE nextSlice #-}
    nextSlice :: Int -> Buffer -> Maybe Buffer
    nextSlice minSize (Buffer fpbuf _ op ope)
      | ope `minusPtr` op <= minSize = Nothing
      | otherwise                    = Just (Buffer fpbuf op op ope)

    ------------------------------------------------------------------------------
    -- Buffer allocation strategies
    ------------------------------------------------------------------------------

    -- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial
    -- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at
    -- least size @minSize@ from a filled buffer @buf@. The double nesting of the
    -- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is
    -- lost as soon as possible, but the new buffer doesn't have to be allocated
    -- too early.
    type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))

    -- | The simplest buffer allocation strategy: whenever a buffer is requested,
    -- allocate a new one that is big enough for the next build step to execute.
    --
    -- NOTE that this allocation strategy may spill quite some memory upon direct
    -- insertion of a bytestring by the builder. Thats no problem for garbage
    -- collection, but it may lead to unreasonably high memory consumption in
    -- special circumstances.
    allNewBuffersStrategy :: Int                 -- Minimal buffer size.
                          -> BufferAllocStrategy
    allNewBuffersStrategy bufSize =
        ( allocBuffer bufSize
        , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) )

    -- | An unsafe, but possibly more efficient buffer allocation strategy:
    -- reuse the buffer, if it is big enough for the next build step to execute.
    reuseBufferStrategy :: IO Buffer
                        -> BufferAllocStrategy
    reuseBufferStrategy buf0 =
        (buf0, tryReuseBuffer)
      where
        tryReuseBuffer reqSize buf
          | bufferSize buf >= reqSize = return $ return (reuseBuffer buf)
          | otherwise                 = return $ allocBuffer reqSize

    ------------------------------------------------------------------------------
    -- Executing puts on a buffer
    ------------------------------------------------------------------------------

    -- | Execute a put on a buffer.
    --
    -- TODO: Generalize over buffer allocation strategy.
    {-# INLINE runPut #-}
    runPut :: Monad m
           => (IO (BuildSignal a) -> m (BuildSignal a)) -- lifting of buildsteps
           -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next
           -> (S.ByteString -> m ())    -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream
           -> Put a                     -- put to execute
           -> Buffer                    -- initial buffer to be used
           -> m (a, Buffer)             -- result of put and remaining buffer
    runPut liftIO outputBuf outputBS (Put put) =
        runStep (put (finalStep))
      where
        finalStep x = buildStep $ \(BufRange op _) -> return $ Done op x

        runStep step buf@(Buffer fpbuf p0 op ope) = do
            let !br = BufRange op ope
            signal <- liftIO $ runBuildStep step br
            case signal of
                Done op' x ->         -- put completed, buffer partially runSteped
                    return (x, Buffer fpbuf p0 op' ope)

                BufferFull minSize op' nextStep -> do
                    buf' <- outputBuf minSize (Buffer fpbuf p0 op' ope)
                    runStep nextStep buf'

                InsertByteString op' bs nextStep
                  | S.null bs ->   -- flushing of buffer required
                      outputBuf 1 (Buffer fpbuf p0 op' ope) >>= runStep nextStep
                  | p0 == op' -> do -- no bytes written: just insert bytestring
                      outputBS bs
                      runStep nextStep buf
                  | otherwise -> do   -- bytes written, insert buffer and bytestring
                      buf' <- outputBuf 1 (Buffer fpbuf p0 op' ope)
                      outputBS bs
                      runStep nextStep buf'