    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------------------------------------------
    -- |
    -- Module      : Data.Binary.Put
    -- Copyright   : Lennart Kolmodin
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>
    -- Stability   : stable
    -- Portability : Portable to Hugs and GHC. Requires MPTCs
    --
    -- The Put monad. A monad for efficiently constructing lazy bytestrings.
    --
    -----------------------------------------------------------------------------

    module Data.Binary.Put (

        -- * The Put type
          Put
        , PutM(..)
        , runPut
        , runPutM
        , putBuilder
        , execPut

        -- * Flushing the implicit parse state
        , flush

        -- * Primitives
        , putWord8
        , putByteString
        , putLazyByteString

        -- * Big-endian primitives
        , putWord16be
        , putWord32be
        , putWord64be

        -- * Little-endian primitives
        , putWord16le
        , putWord32le
        , putWord64le

        -- * Host-endian, unaligned writes
        , putWordhost           -- :: Word   -> Put
        , putWord16host         -- :: Word16 -> Put
        , putWord32host         -- :: Word32 -> Put
        , putWord64host         -- :: Word64 -> Put

      ) where

    import Data.Monoid
    import Data.Binary.Builder (Builder, toLazyByteString)
    import qualified Data.Binary.Builder as B

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

    import Control.Applicative

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

    -- XXX Strict in buffer only.
    data PairS a = PairS a !Builder

    sndS :: PairS a -> Builder
    sndS (PairS _ b) = b

    -- | The PutM type. A Writer monad over the efficient Builder monoid.
    newtype PutM a = Put { unPut :: PairS a }

    -- | Put merely lifts Builder into a Writer monad, applied to ().
    type Put = PutM ()

    instance Functor PutM where
            fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w
            {-# INLINE fmap #-}

    instance Applicative PutM where
            pure    = return
            m <*> k = Put $
                let PairS f w  = unPut m
                    PairS x w' = unPut k
                in PairS (f x) (w `mappend` w')

    -- Standard Writer monad, with aggressive inlining
    instance Monad PutM where
        return a = Put $ PairS a mempty
        {-# INLINE return #-}

        m >>= k  = Put $
            let PairS a w  = unPut m
                PairS b w' = unPut (k a)
            in PairS b (w `mappend` w')
        {-# INLINE (>>=) #-}

        m >> k  = Put $
            let PairS _ w  = unPut m
                PairS b w' = unPut k
            in PairS b (w `mappend` w')
        {-# INLINE (>>) #-}

    tell :: Builder -> Put
    tell b = Put $ PairS () b
    {-# INLINE tell #-}

    putBuilder :: Builder -> Put
    putBuilder = tell
    {-# INLINE putBuilder #-}

    -- | Run the 'Put' monad
    execPut :: PutM a -> Builder
    execPut = sndS . unPut
    {-# INLINE execPut #-}

    -- | Run the 'Put' monad with a serialiser
    runPut :: Put -> L.ByteString
    runPut = toLazyByteString . sndS . unPut
    {-# INLINE runPut #-}

    -- | Run the 'Put' monad with a serialiser and get its result
    runPutM :: PutM a -> (a, L.ByteString)
    runPutM (Put (PairS f s)) = (f, toLazyByteString s)
    {-# INLINE runPutM #-}

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

    -- | Pop the ByteString we have constructed so far, if any, yielding a
    -- new chunk in the result ByteString.
    flush               :: Put
    flush               = tell B.flush
    {-# INLINE flush #-}

    -- | Efficiently write a byte into the output buffer
    putWord8            :: Word8 -> Put
    putWord8            = tell . B.singleton
    {-# INLINE putWord8 #-}

    -- | An efficient primitive to write a strict ByteString into the output buffer.
    -- It flushes the current buffer, and writes the argument into a new chunk.
    putByteString       :: S.ByteString -> Put
    putByteString       = tell . B.fromByteString
    {-# INLINE putByteString #-}

    -- | Write a lazy ByteString efficiently, simply appending the lazy
    -- ByteString chunks to the output buffer
    putLazyByteString   :: L.ByteString -> Put
    putLazyByteString   = tell . B.fromLazyByteString
    {-# INLINE putLazyByteString #-}

    -- | Write a Word16 in big endian format
    putWord16be         :: Word16 -> Put
    putWord16be         = tell . B.putWord16be
    {-# INLINE putWord16be #-}

    -- | Write a Word16 in little endian format
    putWord16le         :: Word16 -> Put
    putWord16le         = tell . B.putWord16le
    {-# INLINE putWord16le #-}

    -- | Write a Word32 in big endian format
    putWord32be         :: Word32 -> Put
    putWord32be         = tell . B.putWord32be
    {-# INLINE putWord32be #-}

    -- | Write a Word32 in little endian format
    putWord32le         :: Word32 -> Put
    putWord32le         = tell . B.putWord32le
    {-# INLINE putWord32le #-}

    -- | Write a Word64 in big endian format
    putWord64be         :: Word64 -> Put
    putWord64be         = tell . B.putWord64be
    {-# INLINE putWord64be #-}

    -- | Write a Word64 in little endian format
    putWord64le         :: Word64 -> Put
    putWord64le         = tell . B.putWord64le
    {-# INLINE putWord64le #-}

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

    -- | /O(1)./ Write 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 -> Put
    putWordhost         = tell . B.putWordhost
    {-# INLINE putWordhost #-}

    -- | /O(1)./ Write a Word16 in native host order and host endianness.
    -- For portability issues see @putWordhost@.
    putWord16host       :: Word16 -> Put
    putWord16host       = tell . B.putWord16host
    {-# INLINE putWord16host #-}

    -- | /O(1)./ Write a Word32 in native host order and host endianness.
    -- For portability issues see @putWordhost@.
    putWord32host       :: Word32 -> Put
    putWord32host       = tell . B.putWord32host
    {-# INLINE putWord32host #-}

    -- | /O(1)./ Write a Word64 in native host order
    -- On a 32 bit machine we write two host order Word32s, in big endian form.
    -- For portability issues see @putWordhost@.
    putWord64host       :: Word64 -> Put
    putWord64host       = tell . B.putWord64host
    {-# INLINE putWord64host #-}