    {-# LANGUAGE ScopedTypeVariables, CPP #-}
    {-# LANGUAGE Unsafe #-}
    {-# OPTIONS_HADDOCK not-home #-}
    -- |
    -- Copyright   : 2010-2011 Simon Meier, 2010 Jasper van der Jeugt
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Simon Meier <iridcode@gmail.com>
    -- Stability   : unstable, private
    -- Portability : GHC
    --
    -- *Warning:* this module is internal. If you find that you need it please
    -- contact the maintainers and explain what you are trying to do and discuss
    -- what you would need in the public API. It is important that you do this as
    -- the module may not be exposed at all in future releases.
    --
    -- The maintainers are glad to accept patches for further
    -- standard encodings of standard Haskell values.
    --
    -- If you need to write your own builder primitives, then be aware that you are
    -- writing code with /all safety belts off/; i.e.,
    -- *this is the code that might make your application vulnerable to buffer-overflow attacks!*
    -- The "Data.ByteString.Builder.Prim.Tests" module provides you with
    -- utilities for testing your encodings thoroughly.
    --
    module Data.ByteString.Builder.Prim.Internal (
      -- * Fixed-size builder primitives
        Size
      , FixedPrim
      , fixedPrim
      , size
      , runF

      , emptyF
      , contramapF
      , pairF
      -- , liftIOF

      , storableToF

      -- * Bounded-size builder primitives
      , BoundedPrim
      , boundedPrim
      , sizeBound
      , runB

      , emptyB
      , contramapB
      , pairB
      , eitherB
      , condB

      -- , liftIOB

      , toB
      , liftFixedToBounded

      -- , withSizeFB
      -- , withSizeBB

      -- * Shared operators
      , (>$<)
      , (>*<)

      -- * Helpers
      , caseWordSize_32_64

      -- * Deprecated
      , boudedPrim
      ) where

    import Foreign
    import Prelude hiding (maxBound)

    #include "MachDeps.h"

    ------------------------------------------------------------------------------
    -- Supporting infrastructure
    ------------------------------------------------------------------------------

    -- | Contravariant functors as in the @contravariant@ package.
    class Contravariant f where
        contramap :: (b -> a) -> f a -> f b

    infixl 4 >$<

    -- | A fmap-like operator for builder primitives, both bounded and fixed size.
    --
    -- Builder primitives are contravariant so it's like the normal fmap, but
    -- backwards (look at the type). (If it helps to remember, the operator symbol
    -- is like (<$>) but backwards.)
    --
    -- We can use it for example to prepend and/or append fixed values to an
    -- primitive.
    --
    -- > import Data.ByteString.Builder.Prim as P
    -- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'"
    -- >  where
    -- >    fixed3 = P.char7 >*< P.char7 >*< P.char7
    --
    -- Note that the rather verbose syntax for composition stems from the
    -- requirement to be able to compute the size / size bound at compile time.
    --
    (>$<) :: Contravariant f => (b -> a) -> f a -> f b
    >$< :: forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
    (>$<) = (b -> a) -> f a -> f b
    forall b a. (b -> a) -> f a -> f b
    forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
    contramap

    instance Contravariant FixedPrim where
        contramap :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
    contramap = (b -> a) -> FixedPrim a -> FixedPrim b
    forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
    contramapF

    instance Contravariant BoundedPrim where
        contramap :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
    contramap = (b -> a) -> BoundedPrim a -> BoundedPrim b
    forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
    contramapB

    -- | Type-constructors supporting lifting of type-products.
    class Monoidal f where
        pair :: f a -> f b -> f (a, b)

    instance Monoidal FixedPrim where
        pair :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
    pair = FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
    forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
    pairF

    instance Monoidal BoundedPrim where
        pair :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
    pair = BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
    forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
    pairB

    infixr 5 >*<

    -- | A pairing/concatenation operator for builder primitives, both bounded and
    -- fixed size.
    --
    -- For example,
    --
    -- > toLazyByteString (primFixed (char7 >*< char7) ('x','y')) = "xy"
    --
    -- We can combine multiple primitives using '>*<' multiple times.
    --
    -- > toLazyByteString (primFixed (char7 >*< char7 >*< char7) ('x',('y','z'))) = "xyz"
    --
    (>*<) :: Monoidal f => f a -> f b -> f (a, b)
    >*< :: forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
    (>*<) = f a -> f b -> f (a, b)
    forall a b. f a -> f b -> f (a, b)
    forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
    pair

    -- | The type used for sizes and sizeBounds of sizes.
    type Size = Int

    ------------------------------------------------------------------------------
    -- Fixed-size builder primitives
    ------------------------------------------------------------------------------

    -- | A builder primitive that always results in a sequence of bytes of a
    -- pre-determined, fixed size.
    data FixedPrim a = FP {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO ())

    fixedPrim :: Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim :: forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    FP

    -- | The size of the sequences of bytes generated by this 'FixedPrim'.
    {-# INLINE CONLIKE size #-}
    size :: FixedPrim a -> Int
    size :: forall a. FixedPrim a -> Int
    size (FP Int
    l a -> Ptr Word8 -> IO ()
    _) = Int
    l

    {-# INLINE CONLIKE runF #-}
    runF :: FixedPrim a -> a -> Ptr Word8 -> IO ()
    runF :: forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
    runF (FP Int
    _ a -> Ptr Word8 -> IO ()
    io) = a -> Ptr Word8 -> IO ()
    io

    -- | The 'FixedPrim' that always results in the zero-length sequence.
    {-# INLINE CONLIKE emptyF #-}
    emptyF :: FixedPrim a
    emptyF :: forall a. FixedPrim a
    emptyF = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    FP Int
    0 (\a
    _ Ptr Word8
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | Encode a pair by encoding its first component and then its second component.
    {-# INLINE CONLIKE pairF #-}
    pairF :: FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
    pairF :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
    pairF (FP Int
    l1 a -> Ptr Word8 -> IO ()
    io1) (FP Int
    l2 b -> Ptr Word8 -> IO ()
    io2) =
        Int -> ((a, b) -> Ptr Word8 -> IO ()) -> FixedPrim (a, b)
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    FP (Int
    l1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    l2) (\(a
    x1,b
    x2) Ptr Word8
    op -> a -> Ptr Word8 -> IO ()
    io1 a
    x1 Ptr Word8
    op IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> b -> Ptr Word8 -> IO ()
    io2 b
    x2 (Ptr Word8
    op Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    l1))

    -- | Change a primitives such that it first applies a function to the value
    -- to be encoded.
    --
    -- Note that primitives are 'Contravariant'
    -- <http://hackage.haskell.org/package/contravariant>. Hence, the following
    -- laws hold.
    --
    -- >contramapF id = id
    -- >contramapF f . contramapF g = contramapF (g . f)
    {-# INLINE CONLIKE contramapF #-}
    contramapF :: (b -> a) -> FixedPrim a -> FixedPrim b
    contramapF :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
    contramapF b -> a
    f (FP Int
    l a -> Ptr Word8 -> IO ()
    io) = Int -> (b -> Ptr Word8 -> IO ()) -> FixedPrim b
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    FP Int
    l (a -> Ptr Word8 -> IO ()
    io (a -> Ptr Word8 -> IO ()) -> (b -> a) -> b -> Ptr Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    f)

    -- | Convert a 'FixedPrim' to a 'BoundedPrim'.
    {-# INLINE CONLIKE toB #-}
    toB :: FixedPrim a -> BoundedPrim a
    toB :: forall a. FixedPrim a -> BoundedPrim a
    toB (FP Int
    l a -> Ptr Word8 -> IO ()
    io) = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP Int
    l (\a
    x Ptr Word8
    op -> a -> Ptr Word8 -> IO ()
    io a
    x Ptr Word8
    op IO () -> IO (Ptr Word8) -> IO (Ptr Word8)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Ptr Word8 -> IO (Ptr Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $! Ptr Word8
    op Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    l))

    -- | Lift a 'FixedPrim' to a 'BoundedPrim'.
    {-# INLINE CONLIKE liftFixedToBounded #-}
    liftFixedToBounded :: FixedPrim a -> BoundedPrim a
    liftFixedToBounded :: forall a. FixedPrim a -> BoundedPrim a
    liftFixedToBounded = FixedPrim a -> BoundedPrim a
    forall a. FixedPrim a -> BoundedPrim a
    toB

    {-# INLINE CONLIKE storableToF #-}
    storableToF :: forall a. Storable a => FixedPrim a
    -- Not all architectures are forgiving of unaligned accesses; whitelist ones
    -- which are known not to trap (either to the kernel for emulation, or crash).
    #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \
        || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \
            && defined(__ARM_FEATURE_UNALIGNED)) \
        || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \
        || defined(powerpc64le_HOST_ARCH)
    storableToF :: forall a. Storable a => FixedPrim a
    storableToF = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    FP (a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)) (\a
    x Ptr Word8
    op -> Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8 -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    op) a
    x)
    #else
    storableToF = FP (sizeOf (undefined :: a)) $ \x op ->
        if ptrToWordPtr op `mod` fromIntegral (alignment (undefined :: a)) == 0 then poke (castPtr op) x
        else with x $ \tp -> copyBytes op (castPtr tp) (sizeOf (undefined :: a))
    #endif

    {-
    {-# INLINE CONLIKE liftIOF #-}
    liftIOF :: FixedPrim a -> FixedPrim (IO a)
    liftIOF (FP l io) = FP l (\xWrapped op -> do x <- xWrapped; io x op)
    -}

    ------------------------------------------------------------------------------
    -- Bounded-size builder primitives
    ------------------------------------------------------------------------------

    -- | A builder primitive that always results in sequence of bytes that is no longer
    -- than a pre-determined bound.
    data BoundedPrim a = BP {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO (Ptr Word8))

    -- | The bound on the size of sequences of bytes generated by this 'BoundedPrim'.
    {-# INLINE CONLIKE sizeBound #-}
    sizeBound :: BoundedPrim a -> Int
    sizeBound :: forall a. BoundedPrim a -> Int
    sizeBound (BP Int
    b a -> Ptr Word8 -> IO (Ptr Word8)
    _) = Int
    b

    -- | @since 0.10.12.0
    boundedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    boundedPrim :: forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    boundedPrim = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP

    {-# DEPRECATED boudedPrim "Use 'boundedPrim' instead" #-}
    boudedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    boudedPrim :: forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    boudedPrim = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP

    {-# INLINE CONLIKE runB #-}
    runB :: BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
    runB :: forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
    runB (BP Int
    _ a -> Ptr Word8 -> IO (Ptr Word8)
    io) = a -> Ptr Word8 -> IO (Ptr Word8)
    io

    -- | Change a 'BoundedPrim' such that it first applies a function to the
    -- value to be encoded.
    --
    -- Note that 'BoundedPrim's are 'Contravariant'
    -- <http://hackage.haskell.org/package/contravariant>. Hence, the following
    -- laws hold.
    --
    -- >contramapB id = id
    -- >contramapB f . contramapB g = contramapB (g . f)
    {-# INLINE CONLIKE contramapB #-}
    contramapB :: (b -> a) -> BoundedPrim a -> BoundedPrim b
    contramapB :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
    contramapB b -> a
    f (BP Int
    b a -> Ptr Word8 -> IO (Ptr Word8)
    io) = Int -> (b -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim b
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP Int
    b (a -> Ptr Word8 -> IO (Ptr Word8)
    io (a -> Ptr Word8 -> IO (Ptr Word8))
    -> (b -> a) -> b -> Ptr Word8 -> IO (Ptr Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    f)

    -- | The 'BoundedPrim' that always results in the zero-length sequence.
    {-# INLINE CONLIKE emptyB #-}
    emptyB :: BoundedPrim a
    emptyB :: forall a. BoundedPrim a
    emptyB = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP Int
    0 (\a
    _ Ptr Word8
    op -> Ptr Word8 -> IO (Ptr Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr Word8
    op)

    -- | Encode a pair by encoding its first component and then its second component.
    {-# INLINE CONLIKE pairB #-}
    pairB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
    pairB :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
    pairB (BP Int
    b1 a -> Ptr Word8 -> IO (Ptr Word8)
    io1) (BP Int
    b2 b -> Ptr Word8 -> IO (Ptr Word8)
    io2) =
        Int
    -> ((a, b) -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim (a, b)
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP (Int
    b1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    b2) (\(a
    x1,b
    x2) Ptr Word8
    op -> a -> Ptr Word8 -> IO (Ptr Word8)
    io1 a
    x1 Ptr Word8
    op IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> Ptr Word8 -> IO (Ptr Word8)
    io2 b
    x2)

    -- | Encode an 'Either' value using the first 'BoundedPrim' for 'Left'
    -- values and the second 'BoundedPrim' for 'Right' values.
    --
    -- Note that the functions 'eitherB', 'pairB', and 'contramapB' (written below
    -- using '>$<') suffice to construct 'BoundedPrim's for all non-recursive
    -- algebraic datatypes. For example,
    --
    -- @
    --maybeB :: BoundedPrim () -> BoundedPrim a -> BoundedPrim (Maybe a)
    --maybeB nothing just = 'maybe' (Left ()) Right '>$<' eitherB nothing just
    -- @
    {-# INLINE CONLIKE eitherB #-}
    eitherB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
    eitherB :: forall a b.
    BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
    eitherB (BP Int
    b1 a -> Ptr Word8 -> IO (Ptr Word8)
    io1) (BP Int
    b2 b -> Ptr Word8 -> IO (Ptr Word8)
    io2) =
        Int
    -> (Either a b -> Ptr Word8 -> IO (Ptr Word8))
    -> BoundedPrim (Either a b)
    forall a.
    Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
    BP (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    b1 Int
    b2)
            (\Either a b
    x Ptr Word8
    op -> case Either a b
    x of Left a
    x1 -> a -> Ptr Word8 -> IO (Ptr Word8)
    io1 a
    x1 Ptr Word8
    op; Right b
    x2 -> b -> Ptr Word8 -> IO (Ptr Word8)
    io2 b
    x2 Ptr Word8
    op)

    -- | Conditionally select a 'BoundedPrim'.
    -- For example, we can implement the ASCII primitive that drops characters with
    -- Unicode codepoints above 127 as follows.
    --
    -- @
    --charASCIIDrop = 'condB' (< \'\\128\') ('liftFixedToBounded' 'Data.ByteString.Builder.Prim.char7') 'emptyB'
    -- @
    {-# INLINE CONLIKE condB #-}
    condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
    condB :: forall a.
    (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
    condB a -> Bool
    p BoundedPrim a
    be1 BoundedPrim a
    be2 =
        (a -> Either a a) -> BoundedPrim (Either a a) -> BoundedPrim a
    forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
    contramapB (\a
    x -> if a -> Bool
    p a
    x then a -> Either a a
    forall a b. a -> Either a b
    Left a
    x else a -> Either a a
    forall a b. b -> Either a b
    Right a
    x) (BoundedPrim a -> BoundedPrim a -> BoundedPrim (Either a a)
    forall a b.
    BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
    eitherB BoundedPrim a
    be1 BoundedPrim a
    be2)

    -- | Select an implementation depending on bitness.
    -- Throw a compile time error if bitness is neither 32 nor 64.
    {-# INLINE caseWordSize_32_64 #-}
    caseWordSize_32_64
      :: a -- Value for 32-bit architecture
      -> a -- Value for 64-bit architecture
      -> a
    #if WORD_SIZE_IN_BITS == 32
    caseWordSize_32_64 = const
    #endif
    #if WORD_SIZE_IN_BITS == 64
    caseWordSize_32_64 :: forall a. a -> a -> a
    caseWordSize_32_64 = (a -> a) -> a -> a -> a
    forall a b. a -> b -> a
    const a -> a
    forall a. a -> a
    id
    #endif