{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}
{-# LANGUAGE MagicHash, UnboxedTuples, PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
#if __GLASGOW_HASKELL__ == 700
-- This is needed as a workaround for an old bug in GHC 7.0.1 (Trac #4498)
{-# LANGUAGE MonoPatBinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
{- | Copyright : (c) 2010-2011 Simon Meier
                 (c) 2010      Jasper van der Jeugt
License        : BSD3-style (see LICENSE)
Maintainer     : Simon Meier <iridcode@gmail.com>
Portability    : GHC

This module provides 'Builder' /primitives/, which are lower level building
blocks for constructing 'Builder's. You don't need to go down to this level but
it can be slightly faster.

Morally, builder primitives are like functions @a -> Builder@, that is they
take a value and encode it as a sequence of bytes, represented as a 'Builder'.
Of course their implementation is a bit more specialised.

Builder primitives come in two forms: fixed-size and bounded-size.

* /Fixed(-size) primitives/ are builder primitives that always result in a
  sequence of bytes of a fixed length. That is, the length is independent of
  the value that is encoded. An example of a fixed size primitive is the
  big-endian encoding of a 'Word64', which always results in exactly 8 bytes.

* /Bounded(-size) primitives/ are builder primitives that always result in a
  sequence of bytes that is no larger than a predetermined bound. That is, the
  bound is independent of the value that is encoded but the actual length will
  depend on the value. An example for a bounded primitive is the UTF-8 encoding
  of a 'Char', which can be 1,2,3 or 4 bytes long, so the bound is 4 bytes.

Note that fixed primitives can be considered as a special case of bounded
primitives, and we can lift from fixed to bounded.

Because bounded primitives are the more general case, in this documentation we
only refer to fixed size primitives where it matters that the resulting
sequence of bytes is of a fixed length. Otherwise, we just refer to bounded
size primitives.

The purpose of using builder primitives is to improve the performance of
'Builder's. These improvements stem from making the two most common steps
performed by a 'Builder' more efficient. We explain these two steps in turn.

The first most common step is the concatenation of two 'Builder's. Internally,
concatenation corresponds to function composition. (Note that 'Builder's can
be seen as difference-lists of buffer-filling functions; cf.
<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dlist>. )
Function composition is a fast /O(1)/ operation. However, we can use bounded
primitives to remove some of these function compositions altogether, which is
more efficient.

The second most common step performed by a 'Builder' is to fill a buffer using
a bounded primitives, which works as follows. The 'Builder' checks whether
there is enough space left to execute the bounded primitive. If there is, then
the 'Builder' executes the bounded primitive and calls the next 'Builder' with
the updated buffer. Otherwise, the 'Builder' signals its driver that it
requires a new buffer. This buffer must be at least as large as the bound of
the primitive. We can use bounded primitives to reduce the number of
buffer-free checks by fusing the buffer-free checks of consecutive 'Builder's.
We can also use bounded primitives to simplify the control flow for signalling
that a buffer is full by ensuring that we check first that there is enough
space left and only then decide on how to encode a given value.

Let us illustrate these improvements on the CSV-table rendering example from
"Data.ByteString.Builder". Its \"hot code\" is the rendering of a table's
cells, which we implement as follows using only the functions from the
'Builder' API.

@
import "Data.ByteString.Builder" as B

renderCell :: Cell -> Builder
renderCell (StringC cs) = renderString cs
renderCell (IntC i)     = B.intDec i

renderString :: String -> Builder
renderString cs = B.charUtf8 \'\"\' \<\> foldMap escape cs \<\> B.charUtf8 \'\"\'
  where
    escape \'\\\\\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\\\'
    escape \'\\\"\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\"\'
    escape c    = B.charUtf8 c
@

Efficient encoding of 'Int's as decimal numbers is performed by @intDec@.
Optimization potential exists for the escaping of 'String's. The above
implementation has two optimization opportunities. First, the buffer-free
checks of the 'Builder's for escaping double quotes and backslashes can be
fused. Second, the concatenations performed by 'foldMap' can be eliminated.
The following implementation exploits these optimizations.

@
import qualified Data.ByteString.Builder.Prim  as P
import           Data.ByteString.Builder.Prim
                 ( 'condB', 'liftFixedToBounded', ('>*<'), ('>$<') )

renderString :: String -\> Builder
renderString cs =
    B.charUtf8 \'\"\' \<\> 'P.primMapListBounded' escape cs \<\> B.charUtf8 \'\"\'
  where
    escape :: 'P.BoundedPrim' Char
    escape =
      'condB' (== \'\\\\\') (fixed2 (\'\\\\\', \'\\\\\')) $
      'condB' (== \'\\\"\') (fixed2 (\'\\\\\', \'\\\"\')) $
      'charUtf8'
    &#160;
    {&#45;\# INLINE fixed2 \#&#45;}
    fixed2 x = 'P.liftFixedToBounded' $ const x '>$<' 'P.char7' '>*<' 'P.char7'
@

The code should be mostly self-explanatory. The slightly awkward syntax is
because the combinators are written such that the size-bound of the resulting
'BoundedPrim' can be computed at compile time. We also explicitly inline the
@fixed2@ primitive, which encodes a fixed tuple of characters, to ensure that
the bound computation happens at compile time. When encoding the following list
of 'String's, the optimized implementation of @renderString@ is two times
faster.

@
maxiStrings :: [String]
maxiStrings = take 1000 $ cycle [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]
@

Most of the performance gain stems from using 'primMapListBounded', which
encodes a list of values from left-to-right with a 'BoundedPrim'. It exploits
the 'Builder' internals to avoid unnecessary function compositions (i.e.,
concatenations). In the future, we might expect the compiler to perform the
optimizations implemented in 'primMapListBounded'. However, it seems that the
code is currently to complicated for the compiler to see through. Therefore, we
provide the 'BoundedPrim' escape hatch, which allows data structures to provide
very efficient encoding traversals, like 'primMapListBounded' for lists.

Note that 'BoundedPrim's are a bit verbose, but quite versatile. Here is an
example of a 'BoundedPrim' for combined HTML escaping and UTF-8 encoding. It
exploits that the escaped character with the maximal Unicode codepoint is \'>\'.

@
{&#45;\# INLINE charUtf8HtmlEscaped \#&#45;}
charUtf8HtmlEscaped :: 'BoundedPrim' Char
charUtf8HtmlEscaped =
    'condB' (>  \'\>\' ) 'charUtf8' $
    'condB' (== \'\<\' ) (fixed4 (\'&\',(\'l\',(\'t\',\';\')))) $        -- &lt;
    'condB' (== \'\>\' ) (fixed4 (\'&\',(\'g\',(\'t\',\';\')))) $        -- &gt;
    'condB' (== \'&\' ) (fixed5 (\'&\',(\'a\',(\'m\',(\'p\',\';\'))))) $  -- &amp;
    'condB' (== \'\"\' ) (fixed5 (\'&\',(\'\#\',(\'3\',(\'4\',\';\'))))) $  -- &\#34;
    'condB' (== \'\\\'\') (fixed5 (\'&\',(\'\#\',(\'3\',(\'9\',\';\'))))) $  -- &\#39;
    ('liftFixedToBounded' 'char7')         -- fallback for 'Char's smaller than \'\>\'
  where
    {&#45;\# INLINE fixed4 \#&#45;}
    fixed4 x = 'liftFixedToBounded' $ const x '>$<'
      char7 '>*<' char7 '>*<' char7 '>*<' char7
    &#160;
    {&#45;\# INLINE fixed5 \#&#45;}
    fixed5 x = 'liftFixedToBounded' $ const x '>$<'
      char7 '>*<' char7 '>*<' char7 '>*<' char7 '>*<' char7
@

This module currently does not expose functions that require the special
properties of fixed-size primitives. They are useful for prefixing 'Builder's
with their size or for implementing chunked encodings. We will expose the
corresponding functions in future releases of this library.
-}



{-
--
--
-- A /bounded primitive/ is a builder primitive that never results in a sequence
-- longer than some fixed number of bytes. This number of bytes must be
-- independent of the value being encoded. Typical examples of bounded
-- primitives are the big-endian encoding of a 'Word64', which results always
-- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always
-- in less or equal to 4 bytes.
--
-- Typically, primitives are implemented efficiently by allocating a buffer (an
-- array of bytes) and repeatedly executing the following two steps: (1)
-- writing to the buffer until it is full and (2) handing over the filled part
-- to the consumer of the encoded value. Step (1) is where bounded primitives
-- are used. We must use a bounded primitive, as we must check that there is
-- enough free space /before/ actually writing to the buffer.
--
-- In term of expressiveness, it would be sufficient to construct all encodings
-- from the single bounded encoding that encodes a 'Word8' as-is. However,
-- this is not sufficient in terms of efficiency. It results in unnecessary
-- buffer-full checks and it complicates the program-flow for writing to the
-- buffer, as buffer-full checks are interleaved with analysing the value to be
-- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a
-- significant effect on overall encoding performance, as encoding primitive
-- Haskell values such as 'Word8's or 'Char's lies at the heart of every
-- encoding implementation.
--
-- The bounded 'Encoding's provided by this module remove this performance
-- problem. Intuitively, they consist of a tuple of the bound on the maximal
-- number of bytes written and the actual implementation of the encoding as a
-- function that modifies a mutable buffer. Hence when executing a bounded
-- 'Encoding', the buffer-full check can be done once before the actual writing
-- to the buffer. The provided 'Encoding's also take care to implement the
-- actual writing to the buffer efficiently. Moreover, combinators are
-- provided to construct new bounded encodings from the provided ones.
--
-- A typical example for using the combinators is a bounded 'Encoding' that
-- combines escaping the ' and \\ characters with UTF-8 encoding. More
-- precisely, the escaping to be done is the one implemented by the following
-- @escape@ function.
--
-- > escape :: Char -> [Char]
-- > escape '\'' = "\\'"
-- > escape '\\' = "\\\\"
-- > escape c    = [c]
--
-- The bounded 'Encoding' that combines this escaping with UTF-8 encoding is
-- the following.
--
-- > import Data.ByteString.Builder.Prim.Utf8 (char)
-- >
-- > {-# INLINE escapeChar #-}
-- > escapeUtf8 :: BoundedPrim Char
-- > escapeUtf8 =
-- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $
-- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $
-- >     char
--
-- The definition of 'escapeUtf8' is more complicated than 'escape', because
-- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in
-- 'escapeChar' compute both the bound on the maximal number of bytes written
-- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required
-- to implement the encoding. Bounded 'Encoding's should always be inlined.
-- Otherwise, the compiler cannot compute the bound on the maximal number of
-- bytes written at compile-time. Without inlinining, it would also fail to
-- optimize the constant encoding of the escape characters in the above
-- example. Functions that execute bounded 'Encoding's also perform
-- suboptimally, if the definition of the bounded 'Encoding' is not inlined.
-- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.
--
-- Currently, the only library that executes bounded 'Encoding's is the
-- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It
-- uses bounded 'Encoding's to implement most of its lazy bytestring builders.
-- Executing a bounded encoding should be done using the corresponding
-- functions in the lazy bytestring builder 'Extras' module.
--
-- TODO: Merge with explanation/example below
--
-- Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by
-- writing a bounded-size sequence of bytes directly to memory. They are
-- lifted to conversions from Haskell values to 'Builder's by wrapping them
-- with a bound-check. The compiler can implement this bound-check very
-- efficiently (i.e, a single comparison of the difference of two pointers to a
-- constant), because the bound of a 'E.Encoding' is always independent of the
-- value being encoded and, in most cases, a literal constant.
--
-- 'E.Encoding's are the primary means for defining conversion functions from
-- primitive Haskell values to 'Builder's. Most 'Builder' constructors
-- provided by this library are implemented that way.
-- 'E.Encoding's are also used to construct conversions that exploit the internal
-- representation of data-structures.
--
-- For example, 'encodeByteStringWith' works directly on the underlying byte
-- array and uses some tricks to reduce the number of variables in its inner
-- loop. Its efficiency is exploited for implementing the @filter@ and @map@
-- functions in "Data.ByteString.Lazy" as
--
-- > import qualified Codec.Bounded.Encoding as E
-- >
-- > filter :: (Word8 -> Bool) -> ByteString -> ByteString
-- > filter p = toLazyByteString . encodeLazyByteStringWithB write
-- >   where
-- >     write = E.encodeIf p E.word8 E.emptyEncoding
-- >
-- > map :: (Word8 -> Word8) -> ByteString -> ByteString
-- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)
--
-- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,
-- these versions use a more efficient inner loop and have the additional
-- advantage that they always result in well-chunked 'L.ByteString's; i.e, they
-- also perform automatic defragmentation.
--
-- We can also use 'E.Encoding's to improve the efficiency of the following
-- 'renderString' function from our UTF-8 CSV table encoding example in
-- "Data.ByteString.Builder".
--
-- > renderString :: String -> Builder
-- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'
-- >   where
-- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'
-- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'
-- >     escape c    = charUtf8 c
--
-- The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes
-- characters and using 'encodeListWith', which implements writing a list of
-- values with a tighter inner loop and no 'mappend'.
--
-- > import Data.ByteString.Builder.Extra     -- assume these
-- > import Data.ByteString.Builder.Prim      -- imports are present
-- >        ( BoundedPrim, encodeIf, (<#>), (#.) )
-- > import Data.ByteString.Builder.Prim.Utf8 (char)
-- >
-- > renderString :: String -> Builder
-- > renderString cs =
-- >     charUtf8 '"' <> primMapListBounded escapedUtf8 cs <> charUtf8 '"'
-- >   where
-- >     escapedUtf8 :: BoundedPrim Char
-- >     escapedUtf8 =
-- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $
-- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $
-- >       char
--
-- This 'Builder' considers a buffer with less than 8 free bytes as full. As
-- all functions are inlined, the compiler is able to optimize the constant
-- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of
-- 'renderString' this implementation is 1.7x faster.
--
-}
{-
Internally, 'Builder's are buffer-fill operations that are
given a continuation buffer-fill operation and a buffer-range to be filled.
A 'Builder' first checks if the buffer-range is large enough. If that's
the case, the 'Builder' writes the sequences of bytes to the buffer and
calls its continuation.  Otherwise, it returns a signal that it requires a
new buffer together with a continuation to be called on this new buffer.
Ignoring the rare case of a full buffer-range, the execution cost of a
'Builder' consists of three parts:

  1. The time taken to read the parameters; i.e., the buffer-fill
     operation to call after the 'Builder' is done and the buffer-range to
     fill.

  2. The time taken to check for the size of the buffer-range.

  3. The time taken for the actual encoding.

We can reduce cost (1) by ensuring that fewer buffer-fill function calls are
required. We can reduce cost (2) by fusing buffer-size checks of sequential
writes. For example, when escaping a 'String' using 'renderString', it would
be sufficient to check before encoding a character that at least 8 bytes are
free. We can reduce cost (3) by implementing better primitive 'Builder's.
For example, 'renderCell' builds an intermediate list containing the decimal
representation of an 'Int'. Implementing a direct decimal encoding of 'Int's
to memory would be more efficient, as it requires fewer buffer-size checks
and less allocation. It is also a planned extension of this library.

The first two cost reductions are supported for user code through functions
in "Data.ByteString.Builder.Extra". There, we continue the above example
and drop the generation time to 0.8ms by implementing 'renderString' more
cleverly. The third reduction requires meddling with the internals of
'Builder's and is not recommended in code outside of this library. However,
patches to this library are very welcome.
-}
module Data.ByteString.Builder.Prim (

  -- * Bounded-size primitives

    BoundedPrim

  -- ** Combinators
  -- | The combinators for 'BoundedPrim's are implemented such that the
  -- size of the resulting 'BoundedPrim' can be computed at compile time.
  , emptyB
  , (>*<)
  , (>$<)
  , eitherB
  , condB

  -- ** Builder construction
  , primBounded
  , primMapListBounded
  , primUnfoldrBounded

  , primMapByteStringBounded
  , primMapLazyByteStringBounded

  -- * Fixed-size primitives
  , FixedPrim

  -- ** Combinators
  -- | The combinators for 'FixedPrim's are implemented such that the
  -- 'Data.ByteString.Builder.Prim.size'
  -- of the resulting 'FixedPrim' is computed at compile time.
  --
  -- The '(>*<)' and '(>$<)' pairing and mapping operators can be used
  -- with 'FixedPrim'.
  , emptyF
  , liftFixedToBounded

  -- ** Builder construction
  -- | In terms of expressivity, the function 'fixedPrim' would be sufficient
  -- for constructing 'Builder's from 'FixedPrim's. The fused variants of
  -- this function are provided because they allow for more efficient
  -- implementations. Our compilers are just not smart enough yet; and for some
  -- of the employed optimizations (see the code of 'primMapByteStringFixed')
  -- they will very likely never be.
  --
  -- Note that functions marked with \"/Heavy inlining./\" are forced to be
  -- inlined because they must be specialized for concrete encodings,
  -- but are rather heavy in terms of code size. We recommend to define a
  -- top-level function for every concrete instantiation of such a function in
  -- order to share its code. A typical example is the function
  -- 'Data.ByteString.Builder.byteStringHex' from "Data.ByteString.Builder.ASCII",
  -- which is implemented as follows.
  --
  -- @
  -- byteStringHex :: S.ByteString -> Builder
  -- byteStringHex = 'primMapByteStringFixed' 'word8HexFixed'
  -- @
  --
  , primFixed
  , primMapListFixed
  , primUnfoldrFixed

  , primMapByteStringFixed
  , primMapLazyByteStringFixed

  -- * Standard encodings of Haskell values

  , module Data.ByteString.Builder.Prim.Binary

  -- ** Character encodings
  , module Data.ByteString.Builder.Prim.ASCII

  -- *** ISO/IEC 8859-1 (Char8)
  -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.
  -- The /Char8/ encoding implemented here works by truncating the Unicode
  -- codepoint to 8-bits and encoding them as a single byte. For the codepoints
  -- 0-255 this corresponds to the ISO/IEC 8859-1 encoding. Note that the
  -- Char8 encoding is equivalent to the ASCII encoding on the Unicode
  -- codepoints 0-127. Hence, functions such as 'intDec' can also be used for
  -- encoding 'Int's as a decimal number with Char8 encoded characters.
  , char8

  -- *** UTF-8
  -- | The UTF-8 encoding can encode all Unicode codepoints.
  -- It is equivalent to the ASCII encoding on the Unicode codepoints 0-127.
  -- Hence, functions such as 'intDec' can also be used for encoding 'Int's as
  -- a decimal number with UTF-8 encoded characters.
  , charUtf8

  , cstring
  , cstringUtf8

{-
  -- * Testing support
  -- | The following four functions are intended for testing use
  -- only. They are /not/ efficient. Basic encodings are efficently executed by
  -- creating 'Builder's from them using the @encodeXXX@ functions explained at
  -- the top of this module.

  , evalF
  , evalB

  , showF
  , showB
-}
  ) where

import           Data.ByteString.Builder.Internal

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

import           Data.Monoid
import           Data.Char (chr, ord)
import           Control.Monad ((<=<), unless)

import           Data.ByteString.Builder.Prim.Internal hiding (size, sizeBound)
import qualified Data.ByteString.Builder.Prim.Internal as I (size, sizeBound)
import           Data.ByteString.Builder.Prim.Binary
import           Data.ByteString.Builder.Prim.ASCII

#if MIN_VERSION_base(4,4,0)
#if MIN_VERSION_base(4,7,0)
import           Foreign
import           Foreign.C.Types
#else
import           Foreign hiding (unsafeForeignPtrToPtr)
#endif
import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
#else
import           Foreign
#endif
import           GHC.Word (Word8 (..))
import           GHC.Exts
import           GHC.IO

------------------------------------------------------------------------------
-- Creating Builders from bounded primitives
------------------------------------------------------------------------------

-- | Encode a value with a 'FixedPrim'.
{-# INLINE primFixed #-}
primFixed :: FixedPrim a -> (a -> Builder)
primFixed :: forall a. FixedPrim a -> a -> Builder
primFixed = BoundedPrim a -> a -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded (BoundedPrim a -> a -> Builder)
-> (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB

-- | Encode a list of values from left-to-right with a 'FixedPrim'.
{-# INLINE primMapListFixed #-}
primMapListFixed :: FixedPrim a -> ([a] -> Builder)
primMapListFixed :: forall a. FixedPrim a -> [a] -> Builder
primMapListFixed = BoundedPrim a -> [a] -> Builder
forall a. BoundedPrim a -> [a] -> Builder
primMapListBounded (BoundedPrim a -> [a] -> Builder)
-> (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB

-- | Encode a list of values represented as an 'Data.List.unfoldr' with a 'FixedPrim'.
{-# INLINE primUnfoldrFixed #-}
primUnfoldrFixed :: FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
primUnfoldrFixed :: forall b a. FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
primUnfoldrFixed = BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
forall b a. BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
primUnfoldrBounded (BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder)
-> (FixedPrim b -> BoundedPrim b)
-> FixedPrim b
-> (a -> Maybe (b, a))
-> a
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedPrim b -> BoundedPrim b
forall a. FixedPrim a -> BoundedPrim a
toB

-- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from
-- left-to-right with a 'FixedPrim'. This function is quite versatile. For
-- example, we can use it to construct a 'Builder' that maps every byte before
-- copying it to the buffer to be filled.
--
-- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder
-- > mapToBuilder f = primMapByteStringFixed (contramapF f word8)
--
-- We can also use it to hex-encode a strict 'S.ByteString' as shown by the
-- 'Data.ByteString.Builder.ASCII.byteStringHex' example above.
{-# INLINE primMapByteStringFixed #-}
primMapByteStringFixed :: FixedPrim Word8 -> (S.ByteString -> Builder)
primMapByteStringFixed :: FixedPrim Word8 -> ByteString -> Builder
primMapByteStringFixed = BoundedPrim Word8 -> ByteString -> Builder
primMapByteStringBounded (BoundedPrim Word8 -> ByteString -> Builder)
-> (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8
-> ByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
toB

-- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from
-- left-to-right with a 'FixedPrim'.
{-# INLINE primMapLazyByteStringFixed #-}
primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.ByteString -> Builder)
primMapLazyByteStringFixed :: FixedPrim Word8 -> ByteString -> Builder
primMapLazyByteStringFixed = BoundedPrim Word8 -> ByteString -> Builder
primMapLazyByteStringBounded (BoundedPrim Word8 -> ByteString -> Builder)
-> (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8
-> ByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
toB

-- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build
-- fusion. Its performance relies on hoisting several variables out of the
-- inner loop.  That's not possible when writing 'encodeListWith' as a 'foldr'.
-- If we had stream fusion for lists, then we could fuse 'encodeListWith', as
-- 'encodeWithStream' can keep control over the execution.


-- | Create a 'Builder' that encodes values with the given 'BoundedPrim'.
--
-- We rewrite consecutive uses of 'primBounded' such that the bound-checks are
-- fused. For example,
--
-- > primBounded (word32 c1) `mappend` primBounded (word32 c2)
--
-- is rewritten such that the resulting 'Builder' checks only once, if ther are
-- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This
-- optimization is not observationally equivalent in a strict sense, as it
-- influences the boundaries of the generated chunks. However, for a user of
-- this library it is observationally equivalent, as chunk boundaries of a lazy
-- 'L.ByteString' can only be observed through the internal interface.
-- Morevoer, we expect that all primitives write much fewer than 4kb (the
-- default short buffer size). Hence, it is safe to ignore the additional
-- memory spilled due to the more agressive buffer wrapping introduced by this
-- optimization.
--
{-# INLINE[1] primBounded #-}
primBounded :: BoundedPrim a -> (a -> Builder)
primBounded :: forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim a
w a
x =
    -- It is important to avoid recursive 'BuildStep's where possible, as
    -- their closure allocation is expensive. Using 'ensureFree' allows the
    -- 'step' to assume that at least 'sizeBound w' free space is available.
    Int -> Builder
ensureFree (BoundedPrim a -> Int
forall a. BoundedPrim a -> Int
I.sizeBound BoundedPrim a
w) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` (forall r. BuildStep r -> BuildStep r) -> Builder
builder forall {b}. (BufferRange -> IO b) -> BufferRange -> IO b
forall r. BuildStep r -> BuildStep r
step
  where
    step :: (BufferRange -> IO b) -> BufferRange -> IO b
step BufferRange -> IO b
k (BufferRange Ptr Word8
op Ptr Word8
ope) = do
        Ptr Word8
op' <- BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB BoundedPrim a
w a
x Ptr Word8
op
        let !br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
op' Ptr Word8
ope
        BufferRange -> IO b
k BufferRange
br'

{-# RULES

"append/primBounded" forall w1 w2 x1 x2.
       append (primBounded w1 x1) (primBounded w2 x2)
     = primBounded (pairB w1 w2) (x1, x2)

"append/primBounded/assoc_r" forall w1 w2 x1 x2 b.
       append (primBounded w1 x1) (append (primBounded w2 x2) b)
     = append (primBounded (pairB w1 w2) (x1, x2)) b

"append/primBounded/assoc_l" forall w1 w2 x1 x2 b.
       append (append b (primBounded w1 x1)) (primBounded w2 x2)
     = append b (primBounded (pairB w1 w2) (x1, x2))
  #-}

-- TODO: The same rules for 'putBuilder (..) >> putBuilder (..)'

-- | Create a 'Builder' that encodes a list of values consecutively using a
-- 'BoundedPrim' for each element. This function is more efficient than
--
-- > mconcat . map (primBounded w)
--
-- or
--
-- > foldMap (primBounded w)
--
-- because it moves several variables out of the inner loop.
{-# INLINE primMapListBounded #-}
primMapListBounded :: BoundedPrim a -> [a] -> Builder
primMapListBounded :: forall a. BoundedPrim a -> [a] -> Builder
primMapListBounded BoundedPrim a
w [a]
xs0 =
    (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ [a]
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
[a]
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step [a]
xs0
  where
    step :: [a]
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step [a]
xs1 BufferRange -> IO (BuildSignal a)
k (BufferRange Ptr Word8
op0 Ptr Word8
ope0) =
        [a] -> Ptr Word8 -> IO (BuildSignal a)
go [a]
xs1 Ptr Word8
op0
      where
        go :: [a] -> Ptr Word8 -> IO (BuildSignal a)
go []          !Ptr Word8
op             = BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
op Ptr Word8
ope0)
        go xs :: [a]
xs@(a
x':[a]
xs') !Ptr Word8
op
          | Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope0 = BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB BoundedPrim a
w a
x' Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> Ptr Word8 -> IO (BuildSignal a)
go [a]
xs'
          | Bool
otherwise                  =
             BuildSignal a -> IO (BuildSignal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
bound Ptr Word8
op ([a]
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step [a]
xs BufferRange -> IO (BuildSignal a)
k)

    bound :: Int
bound = BoundedPrim a -> Int
forall a. BoundedPrim a -> Int
I.sizeBound BoundedPrim a
w

-- TODO: Add 'foldMap/encodeWith' its variants
-- TODO: Ensure rewriting 'primBounded w . f = primBounded (w #. f)'

-- | Create a 'Builder' that encodes a sequence generated from a seed value
-- using a 'BoundedPrim' for each sequence element.
{-# INLINE primUnfoldrBounded #-}
primUnfoldrBounded :: BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
primUnfoldrBounded :: forall b a. BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder
primUnfoldrBounded BoundedPrim b
w a -> Maybe (b, a)
f a
x0 =
    (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ a
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
a
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
fillWith a
x0
  where
    fillWith :: a
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
fillWith a
x BufferRange -> IO (BuildSignal a)
k (BufferRange Ptr Word8
op0 Ptr Word8
ope0) =
        Maybe (b, a) -> Ptr Word8 -> IO (BuildSignal a)
go (a -> Maybe (b, a)
f a
x) Ptr Word8
op0
      where
        go :: Maybe (b, a) -> Ptr Word8 -> IO (BuildSignal a)
go Maybe (b, a)
Nothing        !Ptr Word8
op         = BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
op Ptr Word8
ope0)
        go (Just (b
y, a
x')) !Ptr Word8
op
          | Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope0 = BoundedPrim b -> b -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB BoundedPrim b
w b
y Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (b, a) -> Ptr Word8 -> IO (BuildSignal a)
go (a -> Maybe (b, a)
f a
x')
          | Bool
otherwise                  = BuildSignal a -> IO (BuildSignal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
bound Ptr Word8
op ((BufferRange -> IO (BuildSignal a)) -> BuildSignal a)
-> (BufferRange -> IO (BuildSignal a)) -> BuildSignal a
forall a b. (a -> b) -> a -> b
$
              \(BufferRange Ptr Word8
opNew Ptr Word8
opeNew) -> do
                  !Ptr Word8
opNew' <- BoundedPrim b -> b -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB BoundedPrim b
w b
y Ptr Word8
opNew
                  a
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
fillWith a
x' BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
opNew' Ptr Word8
opeNew)
    bound :: Int
bound = BoundedPrim b -> Int
forall a. BoundedPrim a -> Int
I.sizeBound BoundedPrim b
w

-- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString'
-- using a 'BoundedPrim'. For example, we can write a 'Builder' that filters
-- a strict 'S.ByteString' as follows.
--
-- > import qualified Data.ByteString.Builder.Prim as P
--
-- > filterBS p = P.condB p (P.liftFixedToBounded P.word8) P.emptyB
--
{-# INLINE primMapByteStringBounded #-}
primMapByteStringBounded :: BoundedPrim Word8 -> S.ByteString -> Builder
primMapByteStringBounded :: BoundedPrim Word8 -> ByteString -> Builder
primMapByteStringBounded BoundedPrim Word8
w =
    \ByteString
bs -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
ByteString
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step ByteString
bs
  where
    bound :: Int
bound = BoundedPrim Word8 -> Int
forall a. BoundedPrim a -> Int
I.sizeBound BoundedPrim Word8
w
    step :: ByteString
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step (S.BS ForeignPtr Word8
ifp Int
isize) !BufferRange -> IO (BuildSignal a)
k =
        Ptr Word8 -> BufferRange -> IO (BuildSignal a)
goBS (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
ifp)
      where
        !ipe :: Ptr b
ipe = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
ifp Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
isize
        goBS :: Ptr Word8 -> BufferRange -> IO (BuildSignal a)
goBS !Ptr Word8
ip0 br :: BufferRange
br@(BufferRange Ptr Word8
op0 Ptr Word8
ope)
          | Ptr Word8
ip0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall {b}. Ptr b
ipe = do
              ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
ifp -- input buffer consumed
              BufferRange -> IO (BuildSignal a)
k BufferRange
br

          | Ptr Word8
op0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope =
              Ptr Word8 -> IO (BuildSignal a)
goPartial (Ptr Word8
ip0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
outRemaining Int
inpRemaining)

          | Bool
otherwise  = BuildSignal a -> IO (BuildSignal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
bound Ptr Word8
op0 (Ptr Word8 -> BufferRange -> IO (BuildSignal a)
goBS Ptr Word8
ip0)
          where
            outRemaining :: Int
outRemaining = (Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op0) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bound
            inpRemaining :: Int
inpRemaining = Ptr Any
forall {b}. Ptr b
ipe Ptr Any -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ip0

            goPartial :: Ptr Word8 -> IO (BuildSignal a)
goPartial !Ptr Word8
ipeTmp = Ptr Word8 -> Ptr Word8 -> IO (BuildSignal a)
go Ptr Word8
ip0 Ptr Word8
op0
              where
                go :: Ptr Word8 -> Ptr Word8 -> IO (BuildSignal a)
go !Ptr Word8
ip !Ptr Word8
op
                  | Ptr Word8
ip Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
ipeTmp = do
                      Word8
x   <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ip
                      Ptr Word8
op' <- BoundedPrim Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB BoundedPrim Word8
w Word8
x Ptr Word8
op
                      Ptr Word8 -> Ptr Word8 -> IO (BuildSignal a)
go (Ptr Word8
ip Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
op'
                  | Bool
otherwise =
                      Ptr Word8 -> BufferRange -> IO (BuildSignal a)
goBS Ptr Word8
ip (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
op Ptr Word8
ope)

-- | Chunk-wise application of 'primMapByteStringBounded'.
{-# INLINE primMapLazyByteStringBounded #-}
primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.ByteString -> Builder
primMapLazyByteStringBounded :: BoundedPrim Word8 -> ByteString -> Builder
primMapLazyByteStringBounded BoundedPrim Word8
w =
    (ByteString -> Builder -> Builder)
-> Builder -> ByteString -> Builder
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
L.foldrChunks (\ByteString
x Builder
b -> BoundedPrim Word8 -> ByteString -> Builder
primMapByteStringBounded BoundedPrim Word8
w ByteString
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b) Builder
forall a. Monoid a => a
mempty


------------------------------------------------------------------------------
-- Raw CString encoding
------------------------------------------------------------------------------

#if !MIN_VERSION_base(4,7,0)
-- eqWord# et al. return Bools prior to GHC 7.6
isTrue# :: Bool -> Bool
isTrue# x = x
#endif

-- | A null-terminated ASCII encoded 'CString'. Null characters are not representable.
cstring :: Addr# -> Builder
cstring :: Addr# -> Builder
cstring =
    \Addr#
addr0 -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step Addr#
addr0
  where
    step :: Addr# -> BuildStep r -> BuildStep r
    step :: forall r. Addr# -> BuildStep r -> BuildStep r
step !Addr#
addr !BuildStep r
k br :: BufferRange
br@(BufferRange op0 :: Ptr Word8
op0@(Ptr Addr#
op0#) Ptr Word8
ope)
      | Word8# -> Word8
W8# Word8#
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = BuildStep r
k BufferRange
br
      | Ptr Word8
op0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
ope =
          BuildSignal r -> IO (BuildSignal r)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal r -> IO (BuildSignal r))
-> BuildSignal r -> IO (BuildSignal r)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep r -> BuildSignal r
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
defaultChunkSize Ptr Word8
op0 (Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step Addr#
addr BuildStep r
k)
      | Bool
otherwise = do
          (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
op0# Int#
0# Word8#
ch State# RealWorld
s of
                       State# RealWorld
s' -> (# State# RealWorld
s', () #)
          let br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange (Ptr Word8
op0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
ope
          Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) BuildStep r
k BufferRange
br'
      where
        !ch :: Word8#
ch = Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
0#

-- | A null-terminated UTF-8 encoded 'CString'. Null characters can be encoded as
-- @0xc0 0x80@.
cstringUtf8 :: Addr# -> Builder
cstringUtf8 :: Addr# -> Builder
cstringUtf8 =
    \Addr#
addr0 -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step Addr#
addr0
  where
    step :: Addr# -> BuildStep r -> BuildStep r
    step :: forall r. Addr# -> BuildStep r -> BuildStep r
step !Addr#
addr !BuildStep r
k br :: BufferRange
br@(BufferRange op0 :: Ptr Word8
op0@(Ptr Addr#
op0#) Ptr Word8
ope)
      | Word8# -> Word8
W8# Word8#
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = BuildStep r
k BufferRange
br
      | Ptr Word8
op0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
ope =
          BuildSignal r -> IO (BuildSignal r)
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal r -> IO (BuildSignal r))
-> BuildSignal r -> IO (BuildSignal r)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep r -> BuildSignal r
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
defaultChunkSize Ptr Word8
op0 (Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step Addr#
addr BuildStep r
k)
        -- NULL is encoded as 0xc0 0x80
      | Word8# -> Word8
W8# Word8#
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xc0
      , Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
1#) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 = do
          let !(W8# Word8#
nullByte#) = Word8
0
          (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
op0# Int#
0# Word8#
nullByte# State# RealWorld
s of
                       State# RealWorld
s' -> (# State# RealWorld
s', () #)
          let br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange (Ptr Word8
op0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
ope
          Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) BuildStep r
k BufferRange
br'
      | Bool
otherwise = do
          (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
op0# Int#
0# Word8#
ch State# RealWorld
s of
                       State# RealWorld
s' -> (# State# RealWorld
s', () #)
          let br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange (Ptr Word8
op0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
ope
          Addr# -> BuildStep r -> BuildStep r
forall r. Addr# -> BuildStep r -> BuildStep r
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) BuildStep r
k BufferRange
br'
      where
        !ch :: Word8#
ch = Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
0#

------------------------------------------------------------------------------
-- Char8 encoding
------------------------------------------------------------------------------

-- | Char8 encode a 'Char'.
{-# INLINE char8 #-}
char8 :: FixedPrim Char
char8 :: FixedPrim Char
char8 = (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (Char -> Word8) -> FixedPrim Word8 -> FixedPrim Char
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
word8


------------------------------------------------------------------------------
-- UTF-8 encoding
------------------------------------------------------------------------------

-- | UTF-8 encode a 'Char'.
{-# INLINE charUtf8 #-}
charUtf8 :: BoundedPrim Char
charUtf8 :: BoundedPrim Char
charUtf8 = Int -> (Char -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Char
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim Int
4 ((Word8 -> Ptr Word8 -> IO (Ptr Word8))
-> (Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8))
-> (Word8 -> Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8))
-> (Word8
    -> Word8 -> Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8))
-> Char
-> Ptr Word8
-> IO (Ptr Word8)
forall a.
(Word8 -> a)
-> (Word8 -> Word8 -> a)
-> (Word8 -> Word8 -> Word8 -> a)
-> (Word8 -> Word8 -> Word8 -> Word8 -> a)
-> Char
-> a
encodeCharUtf8 Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall {a} {b} {b}. Storable a => a -> Ptr b -> IO (Ptr b)
f1 Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall {a} {a} {b} {b}.
(Storable a, Storable a) =>
a -> a -> Ptr b -> IO (Ptr b)
f2 Word8 -> Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall {a} {a} {a} {b} {b}.
(Storable a, Storable a, Storable a) =>
a -> a -> a -> Ptr b -> IO (Ptr b)
f3 Word8 -> Word8 -> Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall {a} {a} {a} {a} {b} {b}.
(Storable a, Storable a, Storable a, Storable a) =>
a -> a -> a -> a -> Ptr b -> IO (Ptr b)
f4)
  where
    pokeN :: Int -> (Ptr a -> m a) -> Ptr a -> m (Ptr b)
pokeN Int
n Ptr a -> m a
io Ptr a
op  = Ptr a -> m a
io Ptr a
op m a -> m (Ptr b) -> m (Ptr b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> m (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a
op Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)

    f1 :: a -> Ptr b -> IO (Ptr b)
f1 a
x1          = Int -> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall {m :: * -> *} {a} {a} {b}.
Monad m =>
Int -> (Ptr a -> m a) -> Ptr a -> m (Ptr b)
pokeN Int
1 ((Ptr b -> IO ()) -> Ptr b -> IO (Ptr b))
-> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
op ->    Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
0 a
x1

    f2 :: a -> a -> Ptr b -> IO (Ptr b)
f2 a
x1 a
x2       = Int -> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall {m :: * -> *} {a} {a} {b}.
Monad m =>
Int -> (Ptr a -> m a) -> Ptr a -> m (Ptr b)
pokeN Int
2 ((Ptr b -> IO ()) -> Ptr b -> IO (Ptr b))
-> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
op -> do Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
0 a
x1
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
1 a
x2

    f3 :: a -> a -> a -> Ptr b -> IO (Ptr b)
f3 a
x1 a
x2 a
x3    = Int -> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall {m :: * -> *} {a} {a} {b}.
Monad m =>
Int -> (Ptr a -> m a) -> Ptr a -> m (Ptr b)
pokeN Int
3 ((Ptr b -> IO ()) -> Ptr b -> IO (Ptr b))
-> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
op -> do Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
0 a
x1
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
1 a
x2
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
2 a
x3

    f4 :: a -> a -> a -> a -> Ptr b -> IO (Ptr b)
f4 a
x1 a
x2 a
x3 a
x4 = Int -> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall {m :: * -> *} {a} {a} {b}.
Monad m =>
Int -> (Ptr a -> m a) -> Ptr a -> m (Ptr b)
pokeN Int
4 ((Ptr b -> IO ()) -> Ptr b -> IO (Ptr b))
-> (Ptr b -> IO ()) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
op -> do Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
0 a
x1
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
1 a
x2
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
2 a
x3
                                         Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
op Int
3 a
x4

-- | Encode a Unicode character to another datatype, using UTF-8. This function
-- acts as an abstract way of encoding characters, as it is unaware of what
-- needs to happen with the resulting bytes: you have to specify functions to
-- deal with those.
--
{-# INLINE encodeCharUtf8 #-}
encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8
               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8
               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8
               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8
               -> Char                                     -- ^ Input 'Char'
               -> a                                        -- ^ Result
encodeCharUtf8 :: forall a.
(Word8 -> a)
-> (Word8 -> Word8 -> a)
-> (Word8 -> Word8 -> Word8 -> a)
-> (Word8 -> Word8 -> Word8 -> Word8 -> a)
-> Char
-> a
encodeCharUtf8 Word8 -> a
f1 Word8 -> Word8 -> a
f2 Word8 -> Word8 -> Word8 -> a
f3 Word8 -> Word8 -> Word8 -> Word8 -> a
f4 Char
c = case Char -> Int
ord Char
c of
    Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7F -> Word8 -> a
f1 (Word8 -> a) -> Word8 -> a
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07FF ->
           let x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xC0
               x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F)   Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
           in Word8 -> Word8 -> a
f2 Word8
x1 Word8
x2
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF ->
           let x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xE0
               x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
               x3 :: Word8
x3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
           in Word8 -> Word8 -> Word8 -> a
f3 Word8
x1 Word8
x2 Word8
x3
      | Bool
otherwise ->
           let x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xF0
               x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
               x3 :: Word8
x3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
               x4 :: Word8
x4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
           in Word8 -> Word8 -> Word8 -> Word8 -> a
f4 Word8
x1 Word8
x2 Word8
x3 Word8
x4