{-
  Copyright 2020 Awake Networks

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

-- | This module differs from the "Data.ByteString.Builder" module by
-- writing the octets in reverse order, which lets us compute the length
-- of a submessage by writing that submessage and measuring its length
-- before we write a variadic integer prefix encoding that length.
--
-- Example use:
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (withLengthOf (word64Base128LEVar . fromIntegral) (word32BE 42 <> charUtf8 'λ')))
-- [6,0,0,0,42,206,187]

{-# LANGUAGE BangPatterns #-}

module Proto3.Wire.Reverse
    ( -- * `BuildR` type
      BuildR

      -- * Create `BuildR`s
    , etaBuildR
    , ensure
    , withLengthOf
    , byteString
    , lazyByteString
    , shortByteString
    , word8
    , int8
    , word16BE
    , word16LE
    , int16BE
    , int16LE
    , word32BE
    , word32LE
    , int32BE
    , int32LE
    , word64BE
    , word64LE
    , int64BE
    , int64LE
    , floatBE
    , floatLE
    , doubleBE
    , doubleLE
    , char7
    , string7
    , char8
    , string8
    , charUtf8
    , stringUtf8
    , textUtf8
    , lazyTextUtf8
    , shortTextUtf8
    , wordBase128LEVar
    , wordBase128LEVar_inline
    , word32Base128LEVar
    , word32Base128LEVar_inline
    , word64Base128LEVar
    , word64Base128LEVar_inline
    , vectorBuildR

    -- * Consume `BuildR`s
    , runBuildR
    , toLazyByteString

    -- * Helpful combinators
    , foldlRVector

    -- * Exported for testing purposes only.
    , testWithUnused
    ) where

import           Data.Bits                     ( (.&.) )
import qualified Data.ByteString               as B
import qualified Data.ByteString.Internal      as BI
import qualified Data.ByteString.Lazy          as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString.Short         as BS
import qualified Data.ByteString.Short.Internal as BSI
import qualified Data.ByteString.Unsafe        as BU
import           Data.Char                     ( ord )
import           Data.Int                      ( Int8, Int16, Int32, Int64 )
import qualified Data.Text                     as T
import qualified Data.Text.Internal            as TI
import qualified Data.Text.Internal.Fusion     as TIF
import qualified Data.Text.Lazy                as TL
import qualified Data.Text.Short               as TS
import           Data.Vector.Generic           ( Vector )
import           Data.Word                     ( Word8, Word16, Word32, Word64 )
import           Foreign                       ( castPtr )
import           Proto3.Wire.Reverse.Internal
import qualified Proto3.Wire.Reverse.Prim      as Prim

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :module Proto3.Wire.Reverse

-- | Create a lazy `BL.ByteString` from a `BuildR`
--
-- > toLazyByteString (x <> y) = toLazyByteString x <> toLazyByteString y
-- >
-- > toLazyByteString mempty = mempty
--
-- >>> toLazyByteString (stringUtf8 "ABC")
-- "ABC"
toLazyByteString :: BuildR -> BL.ByteString
toLazyByteString :: BuildR -> ByteString
toLazyByteString = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildR -> (Int, ByteString)
runBuildR

-- | Convert a strict `B.ByteString` to a `BuildR`
--
-- > byteString (x <> y) = byteString x <> byteString y
-- >
-- > byteString mempty = mempty
--
-- >>> byteString "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
byteString :: B.ByteString -> BuildR
byteString :: ByteString -> BuildR
byteString ByteString
bs = (Int -> BuildR) -> BuildR
withUnused forall a b. (a -> b) -> a -> b
$ \Int
unused ->
  let len :: Int
len = ByteString -> Int
B.length ByteString
bs in
  if Int
len forall a. Ord a => a -> a -> Bool
<= Int
unused
    then
      Int -> (Ptr Word8 -> IO ()) -> BuildR
unsafeConsume Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
        forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
src ->
          Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BI.memcpy Ptr Word8
dst (forall a b. Ptr a -> Ptr b
castPtr CString
src) Int
len
    else
      ByteString -> BuildR
prependChunk ByteString
bs

-- | Convert a lazy `BL.ByteString` to a `BuildR`
--
-- Warning: evaluating the length will force the lazy `BL.ByteString`'s chunks,
-- and they will remain allocated until you finish using the builder.
--
-- > lazyByteString (x <> y) = lazyByteString x <> lazyByteString y
-- >
-- > lazyByteString mempty = mempty
--
-- > lazyByteString . toLazyByteString = id
-- >
-- > toLazyByteString . lazyByteString = id
--
-- >>> lazyByteString "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
lazyByteString :: BL.ByteString -> BuildR
lazyByteString :: ByteString -> BuildR
lazyByteString = forall a. (a -> BuildR) -> a -> BuildR
etaBuildR forall a b. (a -> b) -> a -> b
$ ReverseChunks -> ByteString -> BuildR
scan (ByteString -> ReverseChunks
ReverseChunks ByteString
BL.empty)
  where
    scan :: ReverseChunks -> BL.ByteString -> BuildR
    scan :: ReverseChunks -> ByteString -> BuildR
scan ReverseChunks
r ByteString
BLI.Empty = ReverseChunks -> BuildR
prepend ReverseChunks
r
    scan (ReverseChunks ByteString
r) (BLI.Chunk ByteString
c ByteString
cs) =
      ReverseChunks -> ByteString -> BuildR
scan (ByteString -> ReverseChunks
ReverseChunks (ByteString -> ByteString -> ByteString
BLI.Chunk ByteString
c ByteString
r)) ByteString
cs

    prepend :: ReverseChunks -> BuildR
    prepend :: ReverseChunks -> BuildR
prepend (ReverseChunks ByteString
BLI.Empty) = forall a. Monoid a => a
mempty
    prepend (ReverseChunks (BLI.Chunk ByteString
c ByteString
cs)) = (Int -> BuildR) -> BuildR
withUnused forall a b. (a -> b) -> a -> b
$ \Int
unused ->
      let len :: Int
len = ByteString -> Int
B.length ByteString
c in
      if Int
len forall a. Ord a => a -> a -> Bool
<= Int
unused
        then
          (ReverseChunks -> BuildR
prepend (ByteString -> ReverseChunks
ReverseChunks ByteString
cs) forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$
            Int -> (Ptr Word8 -> IO ()) -> BuildR
unsafeConsume Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
              forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
c forall a b. (a -> b) -> a -> b
$ \CString
src ->
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BI.memcpy Ptr Word8
dst (forall a b. Ptr a -> Ptr b
castPtr CString
src) Int
len
        else
          ReverseChunks -> BuildR
prependReverseChunks (ByteString -> ReverseChunks
ReverseChunks(ByteString -> ByteString -> ByteString
BLI.Chunk ByteString
c ByteString
cs))

-- | Convert a `BS.ShortByteString` to a `BuildR`
--
-- > shortByteString (x <> y) = shortByteString x <> shortByteString y
-- >
-- > shortByteString mempty = mempty
--
-- >>> shortByteString "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
shortByteString :: BS.ShortByteString -> BuildR
shortByteString :: ShortByteString -> BuildR
shortByteString ShortByteString
bs = (Int -> BuildR) -> BuildR
withUnused forall a b. (a -> b) -> a -> b
$ \Int
unused ->
    let len :: Int
len = ShortByteString -> Int
BS.length ShortByteString
bs in
    if Int
len forall a. Ord a => a -> a -> Bool
<= Int
unused
      then
        ShortByteString -> Int -> Int -> BuildR
writeChunk ShortByteString
bs Int
0 Int
len
      else
        let rest :: Int
rest = Int
len forall a. Num a => a -> a -> a
- Int
unused in
        ShortByteString -> Int -> Int -> BuildR
writeChunk ShortByteString
bs Int
0 Int
rest forall a. Semigroup a => a -> a -> a
<> Int -> BuildR
reallocate Int
rest forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Int -> Int -> BuildR
writeChunk ShortByteString
bs Int
rest Int
unused
  where
    writeChunk :: ShortByteString -> Int -> Int -> BuildR
writeChunk ShortByteString
src Int
off Int
len =
      Int -> (Ptr Word8 -> IO ()) -> BuildR
unsafeConsume Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
        forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
BSI.copyToPtr ShortByteString
src Int
off Ptr Word8
dst Int
len

-- | Convert a `Word8` to a `BuildR`
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word8 42))
-- [42]
word8 :: Word8 -> BuildR
word8 :: Word8 -> BuildR
word8 = \Word8
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word8 -> FixedPrim 1
Prim.word8 Word8
x))
{-# INLINE word8 #-}

-- | Convert a `Int8` to a `BuildR`
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int8 (-5)))
-- [251]
int8 :: Int8 -> BuildR
int8 :: Int8 -> BuildR
int8 = \Int8
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int8 -> FixedPrim 1
Prim.int8 Int8
x))
{-# INLINE int8 #-}

-- | Convert a `Word16` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word16BE 42))
-- [0,42]
word16BE :: Word16 -> BuildR
word16BE :: Word16 -> BuildR
word16BE = \Word16
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word16 -> FixedPrim 2
Prim.word16BE Word16
x))
{-# INLINE word16BE #-}

-- | Convert a `Word16` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word16LE 42))
-- [42,0]
word16LE :: Word16 -> BuildR
word16LE :: Word16 -> BuildR
word16LE = \Word16
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word16 -> FixedPrim 2
Prim.word16LE Word16
x))
{-# INLINE word16LE #-}

-- | Convert an `Int16` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int16BE (-5)))
-- [255,251]
int16BE :: Int16 -> BuildR
int16BE :: Int16 -> BuildR
int16BE = \Int16
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int16 -> FixedPrim 2
Prim.int16BE Int16
x))
{-# INLINE int16BE #-}

-- | Convert an `Int16` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int16LE (-5)))
-- [251,255]
int16LE :: Int16 -> BuildR
int16LE :: Int16 -> BuildR
int16LE = \Int16
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int16 -> FixedPrim 2
Prim.int16LE Int16
x))
{-# INLINE int16LE #-}

-- | Convert a `Word32` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32BE 42))
-- [0,0,0,42]
word32BE :: Word32 -> BuildR
word32BE :: Word32 -> BuildR
word32BE = \Word32
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word32 -> FixedPrim 4
Prim.word32BE Word32
x))
{-# INLINE word32BE #-}

-- | Convert a `Word32` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32LE 42))
-- [42,0,0,0]
word32LE :: Word32 -> BuildR
word32LE :: Word32 -> BuildR
word32LE = \Word32
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word32 -> FixedPrim 4
Prim.word32LE Word32
x))
{-# INLINE word32LE #-}

-- | Convert an `Int32` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int32BE (-5)))
-- [255,255,255,251]
int32BE :: Int32 -> BuildR
int32BE :: Int32 -> BuildR
int32BE = \Int32
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int32 -> FixedPrim 4
Prim.int32BE Int32
x))
{-# INLINE int32BE #-}

-- | Convert an `Int32` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int32LE (-5)))
-- [251,255,255,255]
int32LE :: Int32 -> BuildR
int32LE :: Int32 -> BuildR
int32LE = \Int32
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int32 -> FixedPrim 4
Prim.int32LE Int32
x))
{-# INLINE int32LE #-}

-- | Convert a `Word64` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64BE 42))
-- [0,0,0,0,0,0,0,42]
word64BE :: Word64 -> BuildR
word64BE :: Word64 -> BuildR
word64BE = \Word64
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word64 -> FixedPrim 8
Prim.word64BE Word64
x))
{-# INLINE word64BE #-}

-- | Convert a `Word64` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64LE 42))
-- [42,0,0,0,0,0,0,0]
word64LE :: Word64 -> BuildR
word64LE :: Word64 -> BuildR
word64LE = \Word64
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Word64 -> FixedPrim 8
Prim.word64LE Word64
x))
{-# INLINE word64LE #-}

-- | Convert an `Int64` to a `BuildR` by storing the bytes in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int64BE (-5)))
-- [255,255,255,255,255,255,255,251]
int64BE :: Int64 -> BuildR
int64BE :: Int64 -> BuildR
int64BE = \Int64
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int64 -> FixedPrim 8
Prim.int64BE Int64
x))
{-# INLINE int64BE #-}

-- | Convert an `Int64` to a `BuildR` by storing the bytes in little-endian
-- order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int64LE (-5)))
-- [251,255,255,255,255,255,255,255]
int64LE :: Int64 -> BuildR
int64LE :: Int64 -> BuildR
int64LE = \Int64
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Int64 -> FixedPrim 8
Prim.int64LE Int64
x))
{-# INLINE int64LE #-}

-- | Convert a `Float` to a `BuildR` by storing the bytes in IEEE-754 format in
-- big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (floatBE 4.2))
-- [64,134,102,102]
floatBE :: Float -> BuildR
floatBE :: Float -> BuildR
floatBE = \Float
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Float -> FixedPrim 4
Prim.floatBE Float
x))
{-# INLINE floatBE #-}

-- | Convert a `Float` to a `BuildR` by storing the bytes in IEEE-754 format in
-- little-endian order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (floatLE 4.2))
-- [102,102,134,64]
floatLE :: Float -> BuildR
floatLE :: Float -> BuildR
floatLE = \Float
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Float -> FixedPrim 4
Prim.floatLE Float
x))
{-# INLINE floatLE #-}

-- | Convert a `Double` to a `BuildR` by storing the bytes in IEEE-754 format
-- in big-endian order
--
-- In other words, the most significant byte is stored first and the least
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (doubleBE 4.2))
-- [64,16,204,204,204,204,204,205]
doubleBE :: Double -> BuildR
doubleBE :: Double -> BuildR
doubleBE = \Double
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Double -> FixedPrim 8
Prim.doubleBE Double
x))
{-# INLINE doubleBE #-}

-- | Convert a `Double` to a `BuildR` by storing the bytes in IEEE-754 format
-- in little-endian order
--
-- In other words, the least significant byte is stored first and the most
-- significant byte is stored last
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (doubleLE 4.2))
-- [205,204,204,204,204,204,16,64]
doubleLE :: Double -> BuildR
doubleLE :: Double -> BuildR
doubleLE = \Double
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
Prim.liftFixedPrim (Double -> FixedPrim 8
Prim.doubleLE Double
x))
{-# INLINE doubleLE #-}

-- | Convert an @ASCII@ `Char` to a `BuildR`
--
-- __Careful:__ If you provide a Unicode character that is not part of the
-- @ASCII@ alphabet this will only encode the lowest 7 bits
--
-- >>> char7 ';'
-- Proto3.Wire.Reverse.lazyByteString ";"
-- >>> char7 'λ' -- Example of truncation
-- Proto3.Wire.Reverse.lazyByteString ";"
char7 :: Char -> BuildR
char7 :: Char -> BuildR
char7 = Word8 -> BuildR
word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8
0x7F forall a. Bits a => a -> a -> a
.&.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE char7 #-}

-- | Convert an @ASCII@ `String` to a `BuildR`
--
-- __Careful:__ If you provide a Unicode `String` that has non-@ASCII@
-- characters then this will only encode the lowest 7 bits of each character
--
-- > string7 (x <> y) = string7 x <> string7 y
-- >
-- > string7 mempty = mempty
--
-- >>> string7 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> string7 "←↑→↓" -- Example of truncation
-- Proto3.Wire.Reverse.lazyByteString "\DLE\DC1\DC2\DC3"
string7 :: String -> BuildR
string7 :: String -> BuildR
string7 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> BuildR
char7
  -- TO DO: 'Data.ByteString.Builder' goes to considerably more effort.
  -- Could we do better here?

-- | Convert an @ISO/IEC 8859-1@ `Char` to a `BuildR`
--
-- __Careful:__ If you provide a Unicode character that is not part of the
-- @ISO/IEC 8859-1@ alphabet then this will only encode the lowest 8 bits
--
-- >>> char8 ';'
-- Proto3.Wire.Reverse.lazyByteString ";"
-- >>> char8 'λ' -- Example of truncation
-- Proto3.Wire.Reverse.lazyByteString "\187"
char8 :: Char -> BuildR
char8 :: Char -> BuildR
char8 = Word8 -> BuildR
word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE char8 #-}

-- | Convert an @ISO/IEC 8859-1@ `String` to a `BuildR`
--
-- __Careful:__ If you provide a Unicode `String` that has non-@ISO/IEC 8859-1@
-- characters then this will only encode the lowest 8 bits of each character
--
-- > string8 (x <> y) = string8 x <> string8 y
-- >
-- > string8 mempty = mempty
--
-- >>> string8 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> string8 "←↑→↓" -- Example of truncation
-- Proto3.Wire.Reverse.lazyByteString "\144\145\146\147"
string8 :: String -> BuildR
string8 :: String -> BuildR
string8 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> BuildR
char8
  -- TO DO: 'Data.ByteString.Builder' goes to considerably more effort.
  -- Could we do better here?

-- | Convert a Unicode `Char` to a `BuildR` using a @UTF-8@ encoding
--
-- >>> charUtf8 'A'
-- Proto3.Wire.Reverse.lazyByteString "A"
-- >>> charUtf8 'λ'
-- Proto3.Wire.Reverse.lazyByteString "\206\187"
-- >>> charUtf8 (Data.Char.chr 0x7FF)
-- Proto3.Wire.Reverse.lazyByteString "\223\191"
-- >>> charUtf8 (Data.Char.chr 0x800)
-- Proto3.Wire.Reverse.lazyByteString "\224\160\128"
-- >>> charUtf8 (Data.Char.chr 0xFFFF)
-- Proto3.Wire.Reverse.lazyByteString "\239\191\191"
-- >>> charUtf8 (Data.Char.chr 0x10000)
-- Proto3.Wire.Reverse.lazyByteString "\240\144\128\128"
-- >>> charUtf8 (Data.Char.chr 0x10FFFF)
-- Proto3.Wire.Reverse.lazyByteString "\244\143\191\191"
charUtf8 :: Char -> BuildR
charUtf8 :: Char -> BuildR
charUtf8 = \Char
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Char -> BoundedPrim 4
Prim.charUtf8 Char
x)
{-# INLINE charUtf8 #-}

-- | Convert a Unicode `String` to a `BuildR` using a @UTF-8@ encoding
--
-- > stringUtf8 (x <> y) = stringUtf8 x <> stringUtf8 y
-- >
-- > stringUtf8 mempty = mempty
--
-- >>> stringUtf8 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> stringUtf8 "←↑→↓"
-- Proto3.Wire.Reverse.lazyByteString "\226\134\144\226\134\145\226\134\146\226\134\147"
-- >>> Data.ByteString.Lazy.hPutStr System.IO.stdout (toLazyByteString (stringUtf8 "←↑→↓\n"))
-- ←↑→↓
stringUtf8 :: String -> BuildR
stringUtf8 :: String -> BuildR
stringUtf8 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> BuildR
charUtf8
  -- TO DO: 'Data.ByteString.Builder' goes to considerably more effort.
  -- Could we do better here?

-- | Convert a Unicode strict `T.Text` to a `BuildR` using a @UTF-8@ encoding
--
-- > textUtf8 (x <> y) = textUtf8 x <> textUtf8 y
-- >
-- > textUtf8 mempty = mempty
--
-- >>> textUtf8 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> textUtf8 "←↑→↓"
-- Proto3.Wire.Reverse.lazyByteString "\226\134\144\226\134\145\226\134\146\226\134\147"
textUtf8 :: T.Text -> BuildR
textUtf8 :: Text -> BuildR
textUtf8 = forall a. (a -> BuildR) -> a -> BuildR
etaBuildR forall a b. (a -> b) -> a -> b
$ \txt :: Text
txt@(TI.Text Array
_ Int
_ Int
word16Count) ->
  case Text -> Stream Char
TIF.reverseStream Text
txt of
    TIF.Stream s -> Step s Char
next s
t0 Size
_ -> Int -> BuildR -> BuildR
ensure Int
bound (s -> BuildR
go s
t0)
      where
        -- Any non-surrogate UTF-16 word encodes a 'Char' whose UTF-8
        -- encoding involves at most 3 octets.  Any surrogate pair is
        -- two UTF-16 words that give rise to 4 octets.  Therefore we
        -- will see at most 3 UTF-8 bytes per UTF-16 word of input.
        --
        -- This is a significant overallocation in the ASCII case,
        -- where we see only one UTF-8 byte per UTF-16 word of input.
        -- If such overallocation becomes a problem, we could implement
        -- a prescan that computes the exact size required.
        --
        -- However, we anticipate that in most cases we will be
        -- building from many text chunks that individually much
        -- smaller than the overall size of the combined result,
        -- making overallocation relatively harmless.
        bound :: Int
bound = Int
3 forall a. Num a => a -> a -> a
* Int
word16Count

        go :: s -> BuildR
go = forall a. (a -> BuildR) -> a -> BuildR
etaBuildR forall a b. (a -> b) -> a -> b
$ \s
t1 -> case s -> Step s Char
next s
t1 of
          Step s Char
TIF.Done -> forall a. Monoid a => a
mempty
          TIF.Skip s
t2 -> s -> BuildR
go s
t2
          TIF.Yield !Char
ch s
t2 ->
            s -> BuildR
go s
t2 forall a. Semigroup a => a -> a -> a
<> forall (w :: Nat). BoundedPrim w -> BuildR
Prim.unsafeBuildBoundedPrim (Char -> BoundedPrim 4
Prim.charUtf8 Char
ch)

-- | Convert a Unicode lazy `TL.Text` to a `BuildR` using a @UTF-8@ encoding
--
-- > lazyTextUtf8 (x <> y) = lazyTextUtf8 x <> lazyTextUtf8 y
-- >
-- > lazyTextUtf8 mempty = mempty
--
-- >>> lazyTextUtf8 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> lazyTextUtf8 "←↑→↓"
-- Proto3.Wire.Reverse.lazyByteString "\226\134\144\226\134\145\226\134\146\226\134\147"
lazyTextUtf8 :: TL.Text -> BuildR
lazyTextUtf8 :: Text -> BuildR
lazyTextUtf8 = forall a. (Text -> a -> a) -> a -> Text -> a
TL.foldrChunks (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BuildR
textUtf8) forall a. Monoid a => a
mempty

-- | Convert a `TS.ShortText` to a `BuildR` using a @UTF-8@ encoding.
--
-- > shortTextUtf8 (x <> y) = shortTextUtf8 x <> shortTextUtf8 y
-- >
-- > shortTextUtf8 mempty = mempty
--
-- >>> shortTextUtf8 "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
-- >>> shortTextUtf8 "←↑→↓"
-- Proto3.Wire.Reverse.lazyByteString "\226\134\144\226\134\145\226\134\146\226\134\147"
shortTextUtf8 :: TS.ShortText -> BuildR
shortTextUtf8 :: ShortText -> BuildR
shortTextUtf8 = ShortByteString -> BuildR
shortByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ShortByteString
TS.toShortByteString

-- | Convert a `Word` to a `BuildR` using this variable-length encoding:
--
--   1. Convert the given value to a base 128 representation
--   without unnecessary digits (that is, omit zero digits
--   unless they are less significant than nonzero digits).
--
--   2. Present those base-128 digits in order of increasing
--   significance (that is, in little-endian order).
--
--   3. Add 128 to every digit except the most significant digit,
--   yielding a sequence of octets terminated by one that is <= 127.
--
-- This encoding is used in the wire format of Protocol Buffers version 3.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
wordBase128LEVar :: Word -> BuildR
wordBase128LEVar :: Word -> BuildR
wordBase128LEVar = \Word
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word -> BoundedPrim 10
Prim.wordBase128LEVar Word
x)
{-# INLINE wordBase128LEVar #-}

-- | Like 'wordBase128LEVar' but inlined, which may bloat your code.  On
-- the other hand, inlining an application to a constant may shrink your code.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (wordBase128LEVar_inline (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
wordBase128LEVar_inline :: Word -> BuildR
wordBase128LEVar_inline :: Word -> BuildR
wordBase128LEVar_inline = \Word
x ->
  forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word -> BoundedPrim 10
Prim.wordBase128LEVar_inline Word
x)
{-# INLINE wordBase128LEVar_inline #-}

-- | Convert a `Word32` to a `BuildR` using this variable-length encoding:
--
--   1. Convert the given value to a base 128 representation
--   without unnecessary digits (that is, omit zero digits
--   unless they are less significant than nonzero digits).
--
--   2. Present those base-128 digits in order of increasing
--   significance (that is, in little-endian order).
--
--   3. Add 128 to every digit except the most significant digit,
--   yielding a sequence of octets terminated by one that is <= 127.
--
-- This encoding is used in the wire format of Protocol Buffers version 3.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
word32Base128LEVar :: Word32 -> BuildR
word32Base128LEVar :: Word32 -> BuildR
word32Base128LEVar = \Word32
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word32 -> BoundedPrim 5
Prim.word32Base128LEVar Word32
x)
{-# INLINE word32Base128LEVar #-}

-- | Like 'word32Base128LEVar' but inlined, which may bloat your code.  On
-- the other hand, inlining an application to a constant may shrink your code.
--
-- Currently 'word32Base128LEVar' is fully inline, so this makes no difference,
-- but in future we might make different default space/speed tradeoffs.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word32Base128LEVar_inline (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
word32Base128LEVar_inline :: Word32 -> BuildR
word32Base128LEVar_inline :: Word32 -> BuildR
word32Base128LEVar_inline = \Word32
x ->
  forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word32 -> BoundedPrim 5
Prim.word32Base128LEVar_inline Word32
x)
{-# INLINE word32Base128LEVar_inline #-}

-- | Like 'word32Base128LEVar' but for 64-bit inputs.
--
-- Inlines when the value fits within 32 bits, but see
-- also 'word64Base128LEVar_inline', which always inlines.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 32)))
-- [128,128,128,128,16]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 56 - 1)))
-- [255,255,255,255,255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 56)))
-- [128,128,128,128,128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 60 - 1)))
-- [255,255,255,255,255,255,255,255,15]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 60)))
-- [128,128,128,128,128,128,128,128,16]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 63 - 1)))
-- [255,255,255,255,255,255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (Data.Bits.shiftL 1 63)))
-- [128,128,128,128,128,128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar (- (1 :: Data.Word.Word64))))
-- [255,255,255,255,255,255,255,255,255,1]
word64Base128LEVar :: Word64 -> BuildR
word64Base128LEVar :: Word64 -> BuildR
word64Base128LEVar = \Word64
x -> forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word64 -> BoundedPrim 10
Prim.word64Base128LEVar Word64
x)
{-# INLINE word64Base128LEVar #-}

-- | Like 'word64Base128LEVar' but inlined, which may bloat your code.  On
-- the other hand, inlining an application to a constant may shrink your code.
--
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline 42))
-- [42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline 5376))
-- [128,42]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 7 - 1)))
-- [127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 7)))
-- [128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 14 - 1)))
-- [255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 14)))
-- [128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 21 - 1)))
-- [255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 21)))
-- [128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 28 - 1)))
-- [255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 28)))
-- [128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 32 - 1)))
-- [255,255,255,255,15]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 32)))
-- [128,128,128,128,16]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 56 - 1)))
-- [255,255,255,255,255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 56)))
-- [128,128,128,128,128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 60 - 1)))
-- [255,255,255,255,255,255,255,255,15]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 60)))
-- [128,128,128,128,128,128,128,128,16]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 63 - 1)))
-- [255,255,255,255,255,255,255,255,127]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (Data.Bits.shiftL 1 63)))
-- [128,128,128,128,128,128,128,128,128,1]
-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word64Base128LEVar_inline (- (1 :: Data.Word.Word64))))
-- [255,255,255,255,255,255,255,255,255,1]
word64Base128LEVar_inline :: Word64 -> BuildR
word64Base128LEVar_inline :: Word64 -> BuildR
word64Base128LEVar_inline = \Word64
x ->
  forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
Prim.liftBoundedPrim (Word64 -> BoundedPrim 10
Prim.word64Base128LEVar_inline Word64
x)
{-# INLINE word64Base128LEVar_inline #-}

-- | Essentially 'foldMap', but iterates right to left for efficiency.
vectorBuildR :: Vector v a => (a -> BuildR) -> v a -> BuildR
vectorBuildR :: forall (v :: * -> *) a.
Vector v a =>
(a -> BuildR) -> v a -> BuildR
vectorBuildR a -> BuildR
f = forall a. (a -> BuildR) -> a -> BuildR
etaBuildR (forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldlRVector (\BuildR
acc a
x -> BuildR
acc forall a. Semigroup a => a -> a -> a
<> a -> BuildR
f a
x) forall a. Monoid a => a
mempty)
{-# INLINE vectorBuildR #-}

-- | Exported for testing purposes only.
testWithUnused :: (Int -> BuildR) -> BuildR
testWithUnused :: (Int -> BuildR) -> BuildR
testWithUnused = (Int -> BuildR) -> BuildR
withUnused
{-# WARNING testWithUnused "Exported for testing purposes only." #-}