proto3-wire 1.1.0 → 1.2.0

raw patch · 10 files changed

+3336/−81 lines, 10 filesdep +ghc-primdep +parameterizeddep +primitivedep ~basedep ~doctestdep ~tastynew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim, parameterized, primitive, transformers, vector

Dependency ranges changed: base, doctest, tasty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• proto3-wire.cabal +22/−6
• src/Proto3/Wire/Builder.hs +4/−3
• src/Proto3/Wire/Decode.hs +7/−0
• src/Proto3/Wire/Encode.hs +310/−69
• src/Proto3/Wire/Reverse.hs +792/−0
• src/Proto3/Wire/Reverse/Internal.hs +715/−0
• src/Proto3/Wire/Reverse/Prim.hs +838/−0
• src/Proto3/Wire/Reverse/Width.hs +113/−0
• test/Main.hs +532/−3

@@ -0,0 +1,3 @@+1.2.0+  - Encode protobuf wire messages in reverse order to improve perfomance+  - Miscellaneous maintenance changes

@@ -1,5 +1,5 @@ name:                proto3-wire-version:             1.1.0+version:             1.2.0 synopsis:            A low-level implementation of the Protocol Buffers (version 3) wire format license:             Apache-2.0 license-file:        LICENSE@@ -9,6 +9,7 @@ category:            Codec build-type:          Simple cabal-version:       >=1.10+extra-source-files:  CHANGELOG.md  library   exposed-modules:     Proto3.Wire@@ -16,22 +17,35 @@                        Proto3.Wire.Class                        Proto3.Wire.Decode                        Proto3.Wire.Encode+                       Proto3.Wire.Reverse+                       Proto3.Wire.Reverse.Prim                        Proto3.Wire.Tutorial                        Proto3.Wire.Types-  build-depends:       base >=4.9 && <=5.0,+  other-modules:       Proto3.Wire.Reverse.Internal+                       Proto3.Wire.Reverse.Width+  build-depends:       base >=4.12 && <=5.0,                        bytestring >=0.10.6.0 && <0.11.0,                        cereal >= 0.5.1 && <0.6,                        containers >=0.5 && < 0.7,                        deepseq ==1.4.*,-                       hashable <1.3,+                       ghc-prim >=0.5.3 && <0.7,+                       hashable <1.4,+                       parameterized >=0.5.0.0 && <1,+                       primitive >=0.6.4 && <0.8,                        safe ==0.3.*,                        text >= 0.2 && <1.3,+                       transformers >=0.5.6.2 && <0.6,                        unordered-containers >= 0.1.0.0 && <0.3,+                       vector >=0.12.0.2 && <0.13,                        QuickCheck >=2.8 && <3.0    hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options:         -O2 -Wall+  ghc-options:         -O2 -Wall -fobject-code+  -- Add any other architectures on which an unaligned poke of a multibyte+  -- value would succeed and be faster than writing the bytes one by one.+  if arch(x86_64) || arch(i386)+    cpp-options:       -DUNALIGNED_POKES  test-suite tests   type:                exitcode-stdio-1.0@@ -41,10 +55,12 @@   build-depends:       base >=4.9 && <=5.0,                        bytestring >=0.10.6.0 && <0.11.0,                        cereal >= 0.5.1 && <0.6,-                       doctest >= 0.7.0 && <0.17,+                       doctest >= 0.7.0 && <0.18,                        proto3-wire,                        QuickCheck >=2.8 && <3.0,                        tasty >= 0.11 && <1.3,                        tasty-hunit >= 0.9 && <0.11,                        tasty-quickcheck >= 0.8.4 && <0.11,-                       text >= 0.2 && <1.3+                       text >= 0.2 && <1.3,+                       transformers >=0.5.6.2 && <0.6,+                       vector >=0.12.0.2 && <0.13

@@ -26,6 +26,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Proto3.Wire.Builder+    {-# DEPRECATED "This module is no longer used by the rest of the proto3-wire package." #-}     (       -- * `Builder` type       Builder@@ -78,13 +79,13 @@ import qualified Data.ByteString.Short         as BS import           Data.Char                     ( ord ) import           Data.Int                      ( Int8, Int16, Int32, Int64 )-import           Data.Semigroup                ( Semigroup(..), Sum(..) )+import           Data.Semigroup                ( Sum(..) ) import           Data.Word                     ( Word8, Word16, Word32, Word64 ) import           System.IO                     ( Handle )  -- $setup--- >>> :set -XOverloadedStrings--- >>> import Data.Semigroup+-- >>> :set -XOverloadedStrings -Wno-warnings-deprecations+-- >>> :module Proto3.Wire.Builder  -- | A `Builder` is like a @"Data.ByteString.Builder".`BB.Builder`@, but also -- memoizes the resulting length so that we can efficiently encode nested

@@ -72,6 +72,8 @@     , repeated     , embedded     , embedded'+      -- * Exported For Doctest Only+    , toMap     ) where  import           Control.Applicative@@ -97,6 +99,10 @@ import           Proto3.Wire.Class import           Proto3.Wire.Types +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> :module Proto3.Wire.Decode Proto3.Wire.Types+ -- | Decode a zigzag-encoded numeric type. -- See: http://stackoverflow.com/questions/2210923/zig-zag-decoding zigZagDecode :: (Num a, Bits a) => a -> a@@ -122,6 +128,7 @@ toMap :: [(FieldNumber, v)] -> M.IntMap [v] toMap kvs0 = M.fromListWith (<>) . map (fmap (:[])) . map (first (fromIntegral . getFieldNumber)) $ kvs0 +-- | Parses data in the raw wire format into an untyped 'Map' representation. decodeWire :: B.ByteString -> Either String [(FieldNumber, ParsedField)] decodeWire bstr = drloop bstr []  where

@@ -38,14 +38,24 @@ -- > 1 `strings` Just "some string" <> -- > 2 `strings` [ "foo", "bar", "baz" ] +{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  module Proto3.Wire.Encode     ( -- * `MessageBuilder` type       MessageBuilder+    , reverseMessageBuilder+    , vectorMessageBuilder     , messageLength-    , sizedMessageBuilder-    , rawMessageBuilder     , toLazyByteString     , unsafeFromLazyByteString @@ -77,30 +87,38 @@     , embedded       -- * Packed repeated fields     , packedVarints+    , packedVarintsV+    , packedBoolsV     , packedFixed32+    , packedFixed32V     , packedFixed64+    , packedFixed64V     , packedFloats+    , packedFloatsV     , packedDoubles+    , packedDoublesV     ) where  import           Data.Bits                     ( (.|.), shiftL, shiftR, xor ) import qualified Data.ByteString               as B-import qualified Data.ByteString.Builder       as BB import qualified Data.ByteString.Lazy          as BL+import           Data.Coerce                   ( coerce ) import           Data.Int                      ( Int32, Int64 )-import           Data.Monoid                   ( (<>) )-import           Data.Semigroup                ( Semigroup )-import qualified Data.Text.Encoding            as Text.Encoding import qualified Data.Text.Lazy                as Text.Lazy-import qualified Data.Text.Lazy.Encoding       as Text.Lazy.Encoding+import           Data.Vector.Generic           ( Vector ) import           Data.Word                     ( Word8, Word32, Word64 )-import qualified Proto3.Wire.Builder           as WB+import           GHC.TypeLits                  ( KnownNat, Nat, type (+) )+import           Parameterized.Data.Semigroup  ( PNullary, PSemigroup(..),+                                                 (&<>) )+import           Parameterized.Data.Monoid     ( PMEmpty(..) )+import qualified Proto3.Wire.Reverse           as RB+import qualified Proto3.Wire.Reverse.Prim      as Prim import           Proto3.Wire.Class import           Proto3.Wire.Types  -- $setup------ >>> :set -XOverloadedStrings+-- >>> :set -XOverloadedStrings -XOverloadedLists+-- >>> :module Proto3.Wire.Encode Proto3.Wire.Class Data.Word  -- | A `MessageBuilder` represents a serialized protobuf message --@@ -110,8 +128,8 @@ -- `MessageBuilder` -- -- Use `toLazyByteString` when you're done assembling the `MessageBuilder`-newtype MessageBuilder = MessageBuilder { unMessageBuilder :: WB.Builder }-  deriving (Semigroup, Monoid)+newtype MessageBuilder = MessageBuilder { unMessageBuilder :: RB.BuildR }+  deriving (Monoid, Semigroup)  instance Show MessageBuilder where   showsPrec prec builder =@@ -120,21 +138,30 @@     where       bytes' = toLazyByteString builder --- | Retrieve the length of a message, in bytes-messageLength :: MessageBuilder -> Word-messageLength = WB.builderLength . unMessageBuilder+-- | Convert a message builder to a 'RB.BuildR'.+reverseMessageBuilder :: MessageBuilder -> RB.BuildR+reverseMessageBuilder = unMessageBuilder --- | Convert a message to a @"Proto3.Wire.Builder".`WB.Builder`@-sizedMessageBuilder :: MessageBuilder -> WB.Builder-sizedMessageBuilder = unMessageBuilder+-- | Eta-expands a function that produces a 'MessageBuilder', so that+-- its input is not evaluated until the builder state is presented.+--+-- This odd combinator seems to help performance at times, though+-- it may change behavior on nonterminating values of type @a@.+etaMessageBuilder :: forall a . (a -> MessageBuilder) -> a -> MessageBuilder+etaMessageBuilder = coerce (RB.etaBuildR @a) --- | Convert a message to a @"Data.ByteString.Builder".`BB.Builder`@-rawMessageBuilder :: MessageBuilder -> BB.Builder-rawMessageBuilder = WB.rawBuilder . unMessageBuilder+-- | Essentially 'foldMap', but iterates right to left for efficiency.+vectorMessageBuilder ::+  forall v a . Vector v a => (a -> MessageBuilder) -> v a -> MessageBuilder+vectorMessageBuilder = coerce (RB.vectorBuildR @v @a) +-- | O(n): Retrieve the length of a message, in bytes.+messageLength :: MessageBuilder -> Word+messageLength = fromIntegral . fst . RB.runBuildR . unMessageBuilder+ -- | Convert a message to a lazy `BL.ByteString` toLazyByteString :: MessageBuilder -> BL.ByteString-toLazyByteString = WB.toLazyByteString . unMessageBuilder+toLazyByteString = RB.toLazyByteString . unMessageBuilder  -- | This lets you cast an arbitrary `ByteString` to a `MessageBuilder`, whether -- or not the `ByteString` corresponds to a valid serialized protobuf message@@ -143,20 +170,82 @@ -- you assemble malformed protobuf `MessageBuilder`s unsafeFromLazyByteString :: BL.ByteString -> MessageBuilder unsafeFromLazyByteString bytes' =-    MessageBuilder { unMessageBuilder = WB.lazyByteString bytes' }+    MessageBuilder { unMessageBuilder = RB.lazyByteString bytes' } -base128Varint :: Word64 -> MessageBuilder-base128Varint = MessageBuilder . WB.word64Base128LEVar+newtype MessageBoundedPrim w+  = MessageBoundedPrim { unMessageBoundedPrim :: Prim.BoundedPrim w } +type instance PNullary MessageBoundedPrim width = MessageBoundedPrim width++instance (w1 + w2) ~ w3 =>+         PSemigroup MessageBoundedPrim w1 w2 w3+  where+    pmappend = coerce (pmappend @Nat @Prim.BoundedPrim)+    {-# INLINE CONLIKE pmappend #-}++instance Prim.AssocPlusNat MessageBoundedPrim u v w+  where+    assocLPlusNat = \p -> coerce (Prim.assocLPlusNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE assocLPlusNat #-}++    assocRPlusNat = \p -> coerce (Prim.assocRPlusNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE assocRPlusNat #-}++instance Prim.CommPlusNat MessageBoundedPrim u v+  where+    commPlusNat = \p -> coerce (Prim.commPlusNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE commPlusNat #-}++instance PMEmpty MessageBoundedPrim 0+  where+    pmempty = coerce (pmempty @Nat @Prim.BoundedPrim)+    {-# INLINE CONLIKE pmempty #-}++instance Prim.Max u v ~ w =>+         Prim.PChoose MessageBoundedPrim u v w+  where+    pbool = coerce (Prim.pbool @Prim.BoundedPrim)+    {-# INLINE CONLIKE pbool #-}++instance Prim.AssocMaxNat MessageBoundedPrim u v w+  where+    assocLMaxNat = \p -> coerce (Prim.assocLMaxNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE assocLMaxNat #-}++    assocRMaxNat = \p -> coerce (Prim.assocRMaxNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE assocRMaxNat #-}++instance Prim.CommMaxNat MessageBoundedPrim u v+  where+    commMaxNat = \p -> coerce (Prim.commMaxNat @Prim.BoundedPrim p)+    {-# INLINE CONLIKE commMaxNat #-}++liftBoundedPrim :: KnownNat w => MessageBoundedPrim w -> MessageBuilder+liftBoundedPrim (MessageBoundedPrim p) = MessageBuilder (Prim.liftBoundedPrim p)+{-# INLINE liftBoundedPrim #-}++base128Varint32 :: Word32 -> MessageBoundedPrim 5+base128Varint32 = MessageBoundedPrim . Prim.word32Base128LEVar+{-# INLINE base128Varint32 #-}++base128Varint64 :: Word64 -> MessageBoundedPrim 10+base128Varint64 = MessageBoundedPrim . Prim.word64Base128LEVar+{-# INLINE base128Varint64 #-}++base128Varint64_inline :: Word64 -> MessageBoundedPrim 10+base128Varint64_inline = MessageBoundedPrim . Prim.word64Base128LEVar_inline+{-# INLINE base128Varint64_inline #-}+ wireType :: WireType -> Word8 wireType Varint = 0 wireType Fixed32 = 5 wireType Fixed64 = 1 wireType LengthDelimited = 2 -fieldHeader :: FieldNumber -> WireType -> MessageBuilder-fieldHeader num wt = base128Varint ((getFieldNumber num `shiftL` 3) .|.-                                        fromIntegral (wireType wt))+fieldHeader :: FieldNumber -> WireType -> MessageBoundedPrim 10+fieldHeader = \num wt -> base128Varint64_inline+    ((getFieldNumber num `shiftL` 3) .|. fromIntegral (wireType wt))+{-# INLINE fieldHeader #-}  -- | Encode a 32-bit "standard" integer --@@ -164,17 +253,32 @@ -- -- >>> 1 `int32` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*"+-- >>> 1 `int64` (-42)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\214\255\255\255\255\255\255\255\255\SOH"+--+-- NOTE: Protobuf encoding converts an @int32@ to a 64-bit unsigned value+-- before encoding it, not a 32-bit value (which would be more efficient).+--+-- To quote the specification: "If you use int32 or int64 as the type for+-- a negative number, the resulting varint is always ten bytes long..."+-- <https://developers.google.com/protocol-buffers/docs/encoding#varints> int32 :: FieldNumber -> Int32 -> MessageBuilder-int32 num i = fieldHeader num Varint <> base128Varint (fromIntegral i)+int32 = \num i -> liftBoundedPrim $+    fieldHeader num Varint &<> base128Varint64 (fromIntegral i)+{-# INLINE int32 #-}  -- | Encode a 64-bit "standard" integer -- -- For example: --+-- >>> 1 `int32` 42+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*" -- >>> 1 `int64` (-42) -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\214\255\255\255\255\255\255\255\255\SOH" int64 :: FieldNumber -> Int64 -> MessageBuilder-int64 num i = fieldHeader num Varint <> base128Varint (fromIntegral i)+int64 = \num i -> liftBoundedPrim $+    fieldHeader num Varint &<> base128Varint64 (fromIntegral i)+{-# INLINE int64 #-}  -- | Encode a 32-bit unsigned integer --@@ -183,7 +287,9 @@ -- >>> 1 `uint32` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*" uint32 :: FieldNumber -> Word32 -> MessageBuilder-uint32 num i = fieldHeader num Varint <> base128Varint (fromIntegral i)+uint32 = \num i -> liftBoundedPrim $+    fieldHeader num Varint &<> base128Varint32 i+{-# INLINE uint32 #-}  -- | Encode a 64-bit unsigned integer --@@ -192,7 +298,9 @@ -- >>> 1 `uint64` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*" uint64 :: FieldNumber -> Word64 -> MessageBuilder-uint64 num i = fieldHeader num Varint <> base128Varint i+uint64 = \num i -> liftBoundedPrim $+    fieldHeader num Varint &<> base128Varint64 i+{-# INLINE uint64 #-}  -- | Encode a 32-bit signed integer --@@ -200,8 +308,14 @@ -- -- >>> 1 `sint32` (-42) -- Proto3.Wire.Encode.unsafeFromLazyByteString "\bS"+-- >>> 1 `sint32` maxBound+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\254\255\255\255\SI"+-- >>> 1 `sint32` minBound+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\255\255\255\255\SI" sint32 :: FieldNumber -> Int32 -> MessageBuilder-sint32 num i = int32 num ((i `shiftL` 1) `xor` (i `shiftR` 31))+sint32 = \num i ->+  uint32 num (fromIntegral ((i `shiftL` 1) `xor` (i `shiftR` 31)))+{-# INLINE sint32 #-}  -- | Encode a 64-bit signed integer --@@ -209,8 +323,14 @@ -- -- >>> 1 `sint64` (-42) -- Proto3.Wire.Encode.unsafeFromLazyByteString "\bS"+-- >>> 1 `sint64` maxBound+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\254\255\255\255\255\255\255\255\255\SOH"+-- >>> 1 `sint64` minBound+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\255\255\255\255\255\255\255\255\255\SOH" sint64 :: FieldNumber -> Int64 -> MessageBuilder-sint64 num i = int64 num ((i `shiftL` 1) `xor` (i `shiftR` 63))+sint64 = \num i ->+  uint64 num (fromIntegral ((i `shiftL` 1) `xor` (i `shiftR` 63)))+{-# INLINE sint64 #-}  -- | Encode a fixed-width 32-bit integer --@@ -219,7 +339,10 @@ -- >>> 1 `fixed32` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\r*\NUL\NUL\NUL" fixed32 :: FieldNumber -> Word32 -> MessageBuilder-fixed32 num i = fieldHeader num Fixed32 <> MessageBuilder (WB.word32LE i)+fixed32 = \num i -> liftBoundedPrim $+    fieldHeader num Fixed32 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.word32LE i))+{-# INLINE fixed32 #-}  -- | Encode a fixed-width 64-bit integer --@@ -228,7 +351,10 @@ -- >>> 1 `fixed64` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t*\NUL\NUL\NUL\NUL\NUL\NUL\NUL" fixed64 :: FieldNumber -> Word64 -> MessageBuilder-fixed64 num i = fieldHeader num Fixed64 <> MessageBuilder (WB.word64LE i)+fixed64 = \num i -> liftBoundedPrim $+    fieldHeader num Fixed64 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.word64LE i))+{-# INLINE fixed64 #-}  -- | Encode a fixed-width signed 32-bit integer --@@ -236,7 +362,10 @@ -- -- > 1 `sfixed32` (-42) sfixed32 :: FieldNumber -> Int32 -> MessageBuilder-sfixed32 num i = fieldHeader num Fixed32 <> MessageBuilder (WB.int32LE i)+sfixed32 = \num i -> liftBoundedPrim $+    fieldHeader num Fixed32 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.int32LE i))+{-# INLINE sfixed32 #-}  -- | Encode a fixed-width signed 64-bit integer --@@ -245,7 +374,10 @@ -- >>> 1 `sfixed64` (-42) -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\214\255\255\255\255\255\255\255" sfixed64 :: FieldNumber -> Int64 -> MessageBuilder-sfixed64 num i = fieldHeader num Fixed64 <> MessageBuilder (WB.int64LE i)+sfixed64 = \num i -> liftBoundedPrim $+    fieldHeader num Fixed64 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.int64LE i))+{-# INLINE sfixed64 #-}  -- | Encode a floating point number --@@ -254,7 +386,10 @@ -- >>> 1 `float` 3.14 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\r\195\245H@" float :: FieldNumber -> Float -> MessageBuilder-float num f = fieldHeader num Fixed32 <> MessageBuilder (WB.floatLE f)+float = \num f -> liftBoundedPrim $+    fieldHeader num Fixed32 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.floatLE f))+{-# INLINE float #-}  -- | Encode a double-precision number --@@ -263,7 +398,10 @@ -- >>> 1 `double` 3.14 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\US\133\235Q\184\RS\t@" double :: FieldNumber -> Double -> MessageBuilder-double num d = fieldHeader num Fixed64 <> MessageBuilder (WB.doubleLE d)+double = \num d -> liftBoundedPrim $+    fieldHeader num Fixed64 &<>+    MessageBoundedPrim (Prim.liftFixedPrim (Prim.doubleLE d))+{-# INLINE double #-}  -- | Encode a value with an enumerable type. --@@ -289,8 +427,10 @@ -- >>> 1 `enum` Triangle <> 2 `enum` Gap3 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\STX\DLE\ETX" enum :: ProtoEnum e => FieldNumber -> e -> MessageBuilder-enum num e =-  fieldHeader num Varint <> base128Varint (fromIntegral (fromProtoEnum e))+enum = \num e -> liftBoundedPrim $+    fieldHeader num Varint &<>+    base128Varint32 (fromIntegral @Int32 @Word32 (fromProtoEnum e))+{-# INLINE enum #-}  -- | Encode a boolean value --@@ -299,14 +439,20 @@ -- >>> 1 `bool` True -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\SOH" bool :: FieldNumber -> Bool -> MessageBuilder-bool num i = fieldHeader num Varint <> base128Varint (fromIntegral (fromEnum i))+bool = \num b -> liftBoundedPrim $+    fieldHeader num Varint &<>+    MessageBoundedPrim+      (Prim.liftFixedPrim (Prim.word8 (fromIntegral (fromEnum b))))+      -- Using word8 instead of a varint encoder shrinks the width bound.+{-# INLINE bool #-}  -- | Encode a sequence of octets as a field of type 'bytes'. ----- >>> 1 `bytes` (Proto3.Wire.Builder.stringUtf8 "testing")+-- >>> 1 `bytes` (Proto3.Wire.Reverse.stringUtf8 "testing") -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"-bytes :: FieldNumber -> WB.Builder -> MessageBuilder+bytes :: FieldNumber -> RB.BuildR -> MessageBuilder bytes num = embedded num . MessageBuilder+{-# INLINE bytes #-}  -- | Encode a UTF-8 string. --@@ -315,7 +461,8 @@ -- >>> 1 `string` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" string :: FieldNumber -> String -> MessageBuilder-string num = embedded num . MessageBuilder . WB.stringUtf8+string num = embedded num . MessageBuilder . RB.stringUtf8+{-# INLINE string #-}  -- | Encode lazy `Text` as UTF-8 --@@ -324,16 +471,8 @@ -- >>> 1 `text` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" text :: FieldNumber -> Text.Lazy.Text -> MessageBuilder-text num txt =-    embedded num (MessageBuilder (WB.unsafeMakeBuilder len (Text.Lazy.Encoding.encodeUtf8Builder txt)))-  where-    -- It would be nice to avoid actually allocating encoded chunks,-    -- but we leave that enhancement for a future time.-    len = Text.Lazy.foldrChunks op 0 txt-    op chnk acc = fromIntegral (B.length (Text.Encoding.encodeUtf8 chnk)) + acc-{-# INLINABLE text #-}-  -- INLINABLE so that if the input is constant, the compiler-  -- has the opportunity to express its length as a CAF.+text num = embedded num . MessageBuilder . RB.lazyTextUtf8+{-# INLINE text #-}  -- | Encode a collection of bytes in the form of a strict 'B.ByteString'. --@@ -342,7 +481,8 @@ -- >>> 1 `byteString` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" byteString :: FieldNumber -> B.ByteString -> MessageBuilder-byteString num bs = embedded num (MessageBuilder (WB.byteString bs))+byteString num = embedded num . MessageBuilder . RB.byteString+{-# INLINE byteString #-}  -- | Encode a lazy bytestring. --@@ -351,43 +491,140 @@ -- >>> 1 `lazyByteString` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" lazyByteString :: FieldNumber -> BL.ByteString -> MessageBuilder-lazyByteString num bl = embedded num (MessageBuilder (WB.lazyByteString bl))+lazyByteString num = embedded num . MessageBuilder . RB.lazyByteString+{-# INLINE lazyByteString #-}  -- | Encode varints in the space-efficient packed format.+-- But consider 'packedVarintsV', which may be faster. ----- >>> 1 `packedVarints` [1, 2, 3]+-- The values to be encoded are specified by mapping the elements of a vector.+--+-- >>> packedVarints 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX" packedVarints :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder-packedVarints num = embedded num . foldMap base128Varint+packedVarints num =+    etaMessageBuilder+      (embedded num . foldMap (liftBoundedPrim . base128Varint64))+{-# INLINE packedVarints #-} +-- | A faster but more specialized variant of:+--+-- > \f num -> packedVarints num . fmap f+--+-- >>> packedVarintsV (subtract 10) 1 ([11, 12, 13] :: Data.Vector.Vector Word64)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX"+packedVarintsV ::+  Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder+packedVarintsV f num =+    embedded num . vectorMessageBuilder (liftBoundedPrim . base128Varint64 . f)+{-# INLINE packedVarintsV #-}++-- | A faster but more specialized variant of:+--+-- > packedVarintsV (fromIntegral . fromEnum) num+--+-- >>> packedBoolsV not 1 ([False, True] :: Data.Vector.Vector Bool)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"+packedBoolsV ::+  Vector v a => (a -> Bool) -> FieldNumber -> v a -> MessageBuilder+packedBoolsV f num =+    embedded num . MessageBuilder . Prim.vectorFixedPrim op+  where+    op = Prim.word8 . fromIntegral . fromEnum . f+{-# INLINE packedBoolsV #-}+ -- | Encode fixed-width Word32s in the space-efficient packed format.+-- But consider 'packedFixed32V', which may be faster. ----- >>> 1 `packedFixed32` [1, 2, 3]+-- The values to be encoded are specified by mapping the elements of a vector.+--+-- >>> packedFixed32 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL" packedFixed32 :: Foldable f => FieldNumber -> f Word32 -> MessageBuilder-packedFixed32 num = embedded num . foldMap (MessageBuilder . WB.word32LE)+packedFixed32 num =+    etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.word32LE))+{-# INLINE packedFixed32 #-} +-- | A faster but more specialized variant of:+--+-- > \f num -> packedFixed32 num . fmap f+--+-- >>> packedFixed32V (subtract 10) 1 ([11, 12, 13] :: Data.Vector.Vector Word32)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"+packedFixed32V ::+  Vector v a => (a -> Word32) -> FieldNumber -> v a -> MessageBuilder+packedFixed32V f num =+    embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.word32LE . f)+{-# INLINE packedFixed32V #-}+ -- | Encode fixed-width Word64s in the space-efficient packed format.+-- But consider 'packedFixed64V', which may be faster. ----- >>> 1 `packedFixed64` [1, 2, 3]+-- The values to be encoded are specified by mapping the elements of a vector.+--+-- >>> packedFixed64 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL" packedFixed64 :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder-packedFixed64 num = embedded num . foldMap (MessageBuilder . WB.word64LE)+packedFixed64 num =+    etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.word64LE))+{-# INLINE packedFixed64 #-} +-- | A faster but more specialized variant of:+--+-- > \f num -> packedFixed64 num . fmap f+--+-- >>> packedFixed64V (subtract 10) 1 ([11, 12, 13] :: Data.Vector.Vector Word64)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"+packedFixed64V ::+  Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder+packedFixed64V f num =+    embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.word64LE . f)+{-# INLINE packedFixed64V #-}+ -- | Encode floats in the space-efficient packed format.+-- But consider 'packedFloatsV', which may be faster. -- -- >>> 1 `packedFloats` [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@" packedFloats :: Foldable f => FieldNumber -> f Float -> MessageBuilder-packedFloats num = embedded num . foldMap (MessageBuilder . WB.floatLE)+packedFloats num =+    etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.floatLE))+{-# INLINE packedFloats #-} +-- | A faster but more specialized variant of:+--+-- > \f num -> packedFloats num . fmap f+--+-- >>> packedFloatsV (subtract 10) 1 ([11, 12, 13] :: Data.Vector.Vector Float)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"+packedFloatsV ::+  Vector v a => (a -> Float) -> FieldNumber -> v a -> MessageBuilder+packedFloatsV f num =+    embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.floatLE . f)+{-# INLINE packedFloatsV #-}+ -- | Encode doubles in the space-efficient packed format.+-- But consider 'packedDoublesV', which may be faster. -- -- >>> 1 `packedDoubles` [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@" packedDoubles :: Foldable f => FieldNumber -> f Double -> MessageBuilder-packedDoubles num = embedded num . foldMap (MessageBuilder . WB.doubleLE)+packedDoubles num =+    etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.doubleLE))+{-# INLINE packedDoubles #-} +-- | A faster but more specialized variant of:+--+-- > \f num -> packedDoubles num . fmap f+--+-- >>> packedDoublesV (subtract 10) 1 ([11, 12, 13] :: Data.Vector.Vector Double)+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"+packedDoublesV ::+  Vector v a => (a -> Double) -> FieldNumber -> v a -> MessageBuilder+packedDoublesV f num =+    embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.doubleLE . f)+{-# INLINE packedDoublesV #-}+ -- | Encode an embedded message. -- -- The message is represented as a 'MessageBuilder', so it is possible to chain@@ -398,6 +635,10 @@ -- >>> 1 `embedded` (1 `string` "this message" <> 2 `string` " is embedded") -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\FS\n\fthis message\DC2\f is embedded" embedded :: FieldNumber -> MessageBuilder -> MessageBuilder-embedded num bb = fieldHeader num LengthDelimited <>-    base128Varint (fromIntegral (messageLength bb)) <>-    bb+embedded = \num (MessageBuilder bb) ->+    MessageBuilder (RB.withLengthOf (Prim.liftBoundedPrim . prefix num) bb)+  where+    prefix num len =+      unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>+      Prim.wordBase128LEVar (fromIntegral @Int @Word len)+{-# INLINE embedded #-}

@@ -0,0 +1,792 @@+{-+  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+    , 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           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 = snd . 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 bs = withUnused $ \unused ->+  let len = B.length bs in+  if len <= unused+    then+      unsafeConsume len $ \dst ->+        BU.unsafeUseAsCString bs $ \src ->+          BI.memcpy dst (castPtr src) len+    else+      prependChunk 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 = etaBuildR $ scan (ReverseChunks BL.empty)+  where+    scan :: ReverseChunks -> BL.ByteString -> BuildR+    scan r BLI.Empty = prepend r+    scan (ReverseChunks r) (BLI.Chunk c cs) =+      scan (ReverseChunks (BLI.Chunk c r)) cs++    prepend :: ReverseChunks -> BuildR+    prepend (ReverseChunks BLI.Empty) = mempty+    prepend (ReverseChunks (BLI.Chunk c cs)) = withUnused $ \unused ->+      let len = B.length c in+      if len <= unused+        then+          (prepend (ReverseChunks cs) <>) $+            unsafeConsume len $ \dst ->+              BU.unsafeUseAsCString c $ \src ->+                BI.memcpy dst (castPtr src) len+        else+          prependReverseChunks (ReverseChunks(BLI.Chunk c 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 bs = withUnused $ \unused ->+    let len = BS.length bs in+    if len <= unused+      then+        writeChunk bs 0 len+      else+        let rest = len - unused in+        writeChunk bs unused rest <> reallocate rest <> writeChunk bs 0 unused+  where+    writeChunk src off len =+      unsafeConsume len $ \dst ->+        BSI.copyToPtr src off dst len++-- | Convert a `Word8` to a `BuildR`+--+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (word8 42))+-- [42]+word8 :: Word8 -> BuildR+word8 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word8 x))+{-# INLINE word8 #-}++-- | Convert a `Int8` to a `BuildR`+--+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (int8 (-5)))+-- [251]+int8 :: Int8 -> BuildR+int8 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word16BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word16LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int16BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int16LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word32BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word32LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int32BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int32LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word64BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.word64LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int64BE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.int64LE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.floatBE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.floatLE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.doubleBE 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 = \x -> Prim.liftBoundedPrim (Prim.liftFixedPrim (Prim.doubleLE 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 = word8 . (0x7F .&.) . fromIntegral . 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 = foldMap 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 = word8 . fromIntegral . 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 = foldMap 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 = \x -> Prim.liftBoundedPrim (Prim.charUtf8 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 = foldMap 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 = etaBuildR $ \txt@(TI.Text _ _ word16Count) ->+  case TIF.reverseStream txt of+    TIF.Stream next t0 _ -> ensure bound (go 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 = 3 * word16Count++        go = etaBuildR $ \t1 -> case next t1 of+          TIF.Done -> mempty+          TIF.Skip t2 -> go t2+          TIF.Yield !ch t2 ->+            go t2 <> Prim.unsafeBuildBoundedPrim (Prim.charUtf8 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 = TL.foldrChunks ((<>) . textUtf8) mempty++-- | 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 = \x -> Prim.liftBoundedPrim (Prim.wordBase128LEVar 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 = \x ->+  Prim.liftBoundedPrim (Prim.wordBase128LEVar_inline 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 = \x -> Prim.liftBoundedPrim (Prim.word32Base128LEVar 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 = \x ->+  Prim.liftBoundedPrim (Prim.word32Base128LEVar_inline 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 = \x -> Prim.liftBoundedPrim (Prim.word64Base128LEVar 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 = \x ->+  Prim.liftBoundedPrim (Prim.word64Base128LEVar_inline x)+{-# INLINE word64Base128LEVar_inline #-}++-- | Essentially 'foldMap', but iterates right to left for efficiency.+vectorBuildR :: Vector v a => (a -> BuildR) -> v a -> BuildR+vectorBuildR f = etaBuildR (foldlRVector (\acc x -> acc <> f x) mempty)+{-# INLINE vectorBuildR #-}++-- | Exported for testing purposes only.+testWithUnused :: (Int -> BuildR) -> BuildR+testWithUnused = withUnused+{-# WARNING testWithUnused "Exported for testing purposes only." #-}

@@ -0,0 +1,715 @@+{-+  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.+-}++-- | Implementation details of the "Data.ByteString.Reverse" module.+-- Breaking changes will be more frequent in this module; use with caution.++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++module Proto3.Wire.Reverse.Internal+    ( BuildR(..)+    , appendBuildR+    , foldlRVector+    , toBuildR+    , fromBuildR+    , etaBuildR+    , runBuildR+    , withUnused+    , withTotal+    , withLengthOf+    , withLengthOf#+    , reallocate+    , prependChunk+    , ReverseChunks(..)+    , prependReverseChunks+    , ensure+    , ensure#+    , unsafeConsume+    , floatToWord32+    , doubleToWord64+    ) where++import           Control.Exception             ( bracket )+import           Control.Monad.Trans.State.Strict ( State, runState, state )+import qualified Data.ByteString               as B+import qualified Data.ByteString.Internal      as BI+import qualified Data.ByteString.Builder.Extra as BB+import qualified Data.ByteString.Lazy          as BL+import qualified Data.ByteString.Lazy.Internal as BLI+import           Data.IORef                    ( IORef, newIORef,+                                                 readIORef, writeIORef )+import qualified Data.Primitive                as P+import qualified Data.Vector.Generic           as VG+import           Data.Vector.Generic           ( Vector )+import           Data.Word                     ( Word8, Word32, Word64 )+import           Foreign                       ( Storable(..),+                                                 castPtrToStablePtr,+                                                 castStablePtrToPtr,+                                                 freeStablePtr, newStablePtr,+                                                 deRefStablePtr )+import           GHC.Exts                      ( Addr#, Int#, MutVar#,+                                                 RealWorld, StablePtr#, State#,+                                                 addrToAny#, int2Addr#,+                                                 touch# )+import           GHC.ForeignPtr                ( ForeignPtr(..),+                                                 ForeignPtrContents(..) )+import           GHC.IO                        ( IO(..) )+import           GHC.IORef                     ( IORef(..) )+import           GHC.Int                       ( Int(..) )+import           GHC.Ptr                       ( Ptr(..), plusPtr )+import           GHC.Stable                    ( StablePtr(..) )+import           GHC.STRef                     ( STRef(..) )+import           System.IO.Unsafe              ( unsafePerformIO )++#if MIN_VERSION_primitive(0,7,0)+#define PTR P.Ptr+#else+#define PTR P.Addr+#endif++-- $setup+-- >>> :set -XOverloadedStrings++-- | Writes bytes in reverse order, updating the current state.+--+-- It is the responsibility of the execution context and buffer+-- management primitives to ensure that the current buffer remains+-- reachable during builder execution, though completed buffers+-- may be copied to new storage at any time.  Aside from those+-- primitives, 'BuildR' implementations may ignore that issue.+--+-- When combining `BuildR`s with '<>' we expect the best performance+-- when associating to the left.  For example @'foldl' ('<>') 'mempty'@,+-- though unless your 'foldl' iteration starts from the right there may+-- still be issues.  Consider using `Proto3.Wire.Reverse.vectorBuildR`+-- instead of 'foldMap'.+newtype BuildR = BuildR+  (Addr# -> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #))+    -- ^ Both the builder arguments and the returned values are:+    --+    --   1. The starting address of the *used* portion of the current buffer.+    --+    --   2. The number of *unused* bytes in the current buffer.+    --+    --   3. The state token (which does not consume any machine registers).+    --+    -- It seems we cannot preserve register allocation between the arguments+    -- and the returned components, even by including padding.  If GHC were to+    -- allocate registers right-to-left (instead of the current left-to-right),+    -- and if it made sure to allocate the register that it uses for closure+    -- arguments *last* when allocating return registers, then we would stand+    -- a chance of not having to move the state components between registers.+    -- That way @a -> b -> 'BuildR'@ and 'BuildR' would use the same registers+    -- for state components as each other, and a non-inline return from one+    -- could be used to call the other without moving state components.+    --+    -- But in many cases register movements combine with increments.+    -- Also, we have arranged to put only the most frequently-used state+    -- components into registers, which reduces the costs of both moves+    -- and of save/reload pairs.  For example, our tracking of the total+    -- bytes written involves metadata at the start of the current buffer+    -- rather than an additional state register.++instance Semigroup BuildR+  where+    (<>) = appendBuildR+    {-# INLINE (<>) #-}++instance Monoid BuildR+  where+    mempty = BuildR (\v u s -> (# v, u, s #))+    {-# INLINE mempty #-}++    mappend = (<>)+    {-# INLINE mappend #-}++instance Show BuildR+  where+    showsPrec prec builder =+        showParen (prec > 10)+          (showString "Proto3.Wire.Reverse.lazyByteString " . shows bytes)+      where+        bytes = snd (runBuildR builder)++-- | Needed for rewrite rules; normally you would use '<>'.+appendBuildR  :: BuildR -> BuildR -> BuildR+appendBuildR = \b c ->+  let BuildR f = b+      BuildR g = c+  in+    BuildR (\v0 u0 s0 -> case g v0 u0 s0 of (# v1, u1, s1 #) -> f v1 u1 s1)+{-# INLINE CONLIKE [1] appendBuildR #-}++-- | Like 'foldl' but iterates right-to-left, which+-- is often useful when creating reverse builders.+foldlRVector :: Vector v a => (b -> a -> b) -> b -> v a -> b+foldlRVector f = \z v -> VG.foldr (flip f) z (VG.reverse v)+  -- It may look like we create a reversed vector here, but thanks to+  -- the rewrite rules in the vector library the vector is never actually+  -- allocated, and instead we directly stream elements from right to left.+{-# INLINE foldlRVector #-}++toBuildR :: (Ptr Word8 -> Int -> IO (Ptr Word8, Int)) -> BuildR+toBuildR f =+  BuildR $ \v0 u0 s0 ->+    let IO g = f (Ptr v0) (I# u0) in+    case g s0 of (# s1, (Ptr v1, I# u1) #) -> (# v1, u1, s1 #)++fromBuildR :: BuildR -> Ptr Word8 -> Int -> IO (Ptr Word8, Int)+fromBuildR (BuildR f) (Ptr v0) (I# u0) =+  IO $ \s0 -> case f v0 u0 s0 of (# v1, u1, s1 #) -> (# s1, (Ptr v1, I# u1) #)++-- | Eta-expands a function that produces a 'BuildR', so that+-- its input is not evaluated until the builder state is presented.+--+-- This odd combinator seems to help performance at times, though+-- it may change behavior on nonterminating values of type @a@.+etaBuildR :: (a -> BuildR) -> a -> BuildR+etaBuildR f x = toBuildR $ \v u -> fromBuildR (f x) v u++-- | The current state of execution of a builder+-- is a @'StablePtr' ('IORef' 'BuildRState')@.+--+-- Current Buffer Layout:+--+-- We devote the first few octets of the current buffer+-- to metadata that does not change very frequently:+--+--   * 'Addr#': cast to 'StablePtr# (IORef BuildRState)'; indirect acceses+--   to the full builder state, which is used relatively infrequently.+--+--   * 'Int#': the total number of non-metadata bytes originally available+--   within the current buffer before we started consuming them,+--   *plus* the number of bytes actually written to previous buffers.+--   We subtract the current unused figure to get the total bytes written.+--+--   * `GHC.Float.Double#`: suitably-aligned scratch space for serialization+--   of 'Double' and 'Float' values.+--+-- Though this choice imposes a small memory overhead in every buffer,+-- it reduces the time and space required to save and restore metadata+-- around the many non-inline calls that typically occur while writing+-- data into the buffer.+data BuildRState = BuildRState+  { currentBuffer :: {-# UNPACK #-}!(P.MutableByteArray RealWorld)+      -- ^ Specifies the current buffer.  Note that through this field+      -- every @'StablePtr' ('IORef' 'BuildRState')@ keeps one buffer+      -- reachable until that stable pointer is explicitly destroyed.+  , sealedBuffers :: BL.ByteString+      -- ^ Holds the bytes written to previous buffers.  We arrange for+      -- this field to be in normal form (not just weak head normal form).+      -- But to avoid redundant evaluation we do not mark it strict.+  }++-- | Allocates fields backward from offset 0 relative to some hypothetical+-- address, yielding the total size and alignment requirements, respectively,+-- along with the monadic return value.  The total size includes any padding+-- at the end that is needed to make it a multiple of the overall alignment.+allocateFields :: State (Int, Int) a -> (a, Int, Int)+allocateFields fields = (x, size, align)+  where+    (x, (off, align)) = runState fields (0, 1)+    size = mod off align - off+      -- Aligns the overall size @- off@ by prepending @mod off align@ padding+      -- bytes.  Because @mod off align@ is in @[0, align)@ we are are neither+      -- removing bytes nor adding more than we need.  And for some @k@ we have+      --+      -- > mod off align == off + k * align+      --+      -- and therefore we achieve the precise alignment desired:+      --+      -- > size = (off + k * align) - off == k * align++-- | Within the monadic context established by 'allocateFields',+-- allocates one suitably-aligned field and returns its offset.+-- The argument is only a proxy for its type; we never evaluate it,+-- and therefore you may pass 'undefined'.+--+-- WARNING: We assume that 'max' is the same as 'lcm' for any pair of+-- alignment values, so that we can avoid using 'lcm', which does not+-- evaluate at compile time.  Compile-time evaluation helps our speed.+allocatePrimitiveField :: Storable a => a -> State (Int, Int) Int+allocatePrimitiveField proxy = state $ \(prevOff, prevAlign) ->+  let fieldWidth = sizeOf proxy+      fieldAlign = alignment proxy+      unaligned = prevOff - fieldWidth+      nextOff = unaligned - mod unaligned fieldAlign+      nextAlign = max prevAlign fieldAlign+  in (nextOff, (nextOff, nextAlign))++scratchOffset, spaceOffset, stateOffset, metaDataSize, metaDataAlign :: Int+((scratchOffset, spaceOffset, stateOffset), metaDataSize, metaDataAlign) =+  allocateFields $+    (,,) <$> allocatePrimitiveField (undefined :: Double)+         <*> allocatePrimitiveField (undefined :: Int)+         <*> allocatePrimitiveField (undefined :: Ptr ())+               -- Note that we are allocating backward, so this+               -- will put the pointer at the lowest address.++smallChunkSize, defaultChunkSize :: Int+smallChunkSize = BB.smallChunkSize - metaDataSize+defaultChunkSize = BB.defaultChunkSize - metaDataSize++data MetaData++metaPtr :: Ptr Word8 -> Int -> Ptr MetaData+metaPtr v = plusPtr v . negate++readState :: Ptr MetaData -> IO (StablePtr (IORef BuildRState))+readState m = castPtrToStablePtr <$> peekByteOff m stateOffset++writeState :: Ptr MetaData -> StablePtr (IORef BuildRState) -> IO ()+writeState m = pokeByteOff m stateOffset . castStablePtrToPtr++readSpace :: Ptr MetaData -> IO Int+readSpace m = peekByteOff m spaceOffset++writeSpace :: Ptr MetaData -> Int -> IO ()+writeSpace m = pokeByteOff m spaceOffset++-- | The arguments are the same as the 'BuildR' arguments.+readTotal :: Ptr Word8 -> Int -> IO Int+readTotal v unused = do+  -- Because we do not wish to update a record of the total+  -- every time we write a byte, instead we record "space",+  -- which changes rarely, and subtract "unused" from it+  -- when we need to compute the total, which is somewhat+  -- frequent but not as frequent as updates to "unused".+  space <- readSpace (metaPtr v unused)+  let !total = space - unused++  -- GHC (at least v8.2.2 and v8.6.5) seems quite eager to delay the above+  -- subtraction, even though we have indicated that the computation of+  -- "total" is strict, and even though delaying the subtraction across+  -- a non-inline call requires saving and restoring two registers+  -- ("space" and "unused") instead of one ("total").  Unless we were to+  -- completely ignore the result of the subtraction, which would be quite+  -- unusual, an eager subtraction is faster.  Therefore we force it:+  strictify total++-- | Sometimes GHC (at least v8.2.2 and v8.6.5) appears to be lazy even with+-- unlifted values, and we apply this combination to force computation so that+-- we do not have to save and restore the several inputs to the computation.+--+-- The implementation requires converting the 'Int#' to a lifted pointer+-- type and then invoking 'touch#' on it, which is slightly questionable+-- because we would crash if the garbage collector actually followed the+-- converted value.  But there would be no reason to collect between the+-- conversion and the 'touch#' because that span involves no computation.+strictify :: Int -> IO Int+strictify (I# x) = IO $ \s0 ->+  case addrToAny# (int2Addr# x) of+    (# y #) -> case touch# y s0 of+      s1 -> (# s1, I# x #)++-- | Allocates a new buffer and stores a pointer to that buffer in+-- the 'currentBuffer' field of the overall builder state, along with the+-- first argument, then returns a pointer to the end of the payload area.+--+-- (This is a manual wrapper around 'newBuffer#'.)+newBuffer ::+  -- | All bytes previously written.+  --+  -- It is ASSUMED that the caller already fully+  -- evaluated this otherwise-lazy 'BL.ByteString'.+  BL.ByteString ->+  -- | Total number of bytes previously written.+  Int ->+  -- | Builder state variable.  The old value of this variable+  -- will NOT be used; rather, it will be overwritten.+  -- Therefore that old value may be 'undefined'.+  IORef BuildRState ->+  -- | Stable pointer to builder state variable.+  StablePtr (IORef BuildRState) ->+  -- | Desired payload size of new current buffer, not counting metadata.+  Int ->+  IO (Ptr Word8)+newBuffer sealed (I# total) (IORef (STRef stateVar)) (StablePtr stateSP)+          (I# unused) =+  IO $ \s0 ->+    case newBuffer# sealed total stateVar stateSP unused s0 of+      (# s1, addr #) -> (# s1, Ptr addr #)++newBuffer# ::+  BL.ByteString ->+  Int# ->+  MutVar# RealWorld BuildRState ->+  StablePtr# (IORef BuildRState) ->+  Int# ->+  State# RealWorld ->+  (# State# RealWorld, Addr# #)+newBuffer# sealed total stateVar stateSP unused s0 =+    case go s0 of+      (# s1, Ptr addr #) -> (# s1, addr #)+  where+    IO go = do+      let allocation = metaDataSize + I# unused+      buf <- P.newAlignedPinnedByteArray allocation metaDataAlign+      let !(PTR base) = P.mutableByteArrayContents buf+          !v = plusPtr (Ptr base) (metaDataSize + I# unused)+          !m = plusPtr (Ptr base) metaDataSize+      writeState m (StablePtr stateSP)+      writeSpace m (I# unused + I# total)+      let !nextState = BuildRState{currentBuffer = buf, sealedBuffers = sealed}+      writeIORef (IORef (STRef stateVar)) nextState+      pure v++-- | The result of a call to 'sealBuffer'.+data SealedState = SealedState+  { sealedSB :: BL.ByteString+      -- ^ All bytes written thus far.+  , totalSB :: {-# UNPACK #-}!Int+      -- ^ The total number of bytes written thus far.+  , stateVarSB :: {-# UNPACK #-}!(IORef BuildRState)+      -- ^ The builder state variable.+      -- This function does NOT modify that variable--it will still+      -- refer to the old buffer unless and until you modify it.+  , statePtrSB :: {-# UNPACK #-}!(StablePtr (IORef BuildRState))+      -- ^ The stable pointer to the variable referenced by 'stateVarSB'.+  , recycledSB :: Maybe (P.MutableByteArray RealWorld)+      -- ^ Returns ownership of the old current buffer to the caller+      -- if it is no longer needed to track the already-written bytes.+      --+      -- If you reuse it within the same builder then there is+      -- no need to reset the stable pointer to the state variable,+      -- but please be sure to update the "space" metadatum.+  }++-- | Takes ownership of the current buffer,+-- but sometimes hands it back for reuse.+--+-- If more building is required then please allocate a new current buffer+-- and update the builder state variable accordingly.+--+-- (This is a manual wrapper around 'sealBuffer#'.)+sealBuffer ::+  -- | Pointer to the used portion of the current buffer.+  Ptr Word8 ->+  -- | The number of bytes still unused in the current buffer.+  Int ->+  IO SealedState+sealBuffer (Ptr addr) (I# u) = IO $ \s0 ->+  case sealBuffer# addr u s0 of+    (# s1, sealed, total, stateVar, statePtr, recycled #) ->+      (# s1+       , SealedState+           { sealedSB = sealed+           , totalSB = I# total+           , stateVarSB = IORef (STRef stateVar)+           , statePtrSB = StablePtr statePtr+           , recycledSB = recycled+           }+       #)++sealBuffer# ::+  Addr# ->+  Int# ->+  State# RealWorld ->+  (# State# RealWorld+   , BL.ByteString+   , Int#+   , MutVar# RealWorld BuildRState+   , StablePtr# (IORef BuildRState)+   , Maybe (P.MutableByteArray RealWorld)+   #)+sealBuffer# addr unused s0 =+    case go s0 of+      (# s1, (sealed, I# total, IORef (STRef sv), StablePtr sp, re) #) ->+        (# s1, sealed, total, sv, sp, re #)+  where+    IO go = do+      let v = Ptr addr+      statePtr <- readState (metaPtr v (I# unused))+      stateVar <- deRefStablePtr statePtr+      BuildRState { currentBuffer = buffer, sealedBuffers = oldSealed } <-+       readIORef stateVar+      total <- readTotal v (I# unused)+      -- The above call to 'readTotal' is the last access of the current+      -- buffer through a raw pointer made by this function.  Therefore+      -- we must be sure that the current buffer remains reachable at this+      -- point in the state thread.  And we are sure of that fact, because+      -- until a state action frees the stable pointer or modifies the state+      -- variable, the stable pointer will reference the state variable,+      -- which in turn will reference the current buffer.+      let allocation = P.sizeofMutableByteArray buffer - metaDataSize+      if allocation <= I# unused+        then+          pure (oldSealed, total, stateVar, statePtr, Just buffer)+        else do+          let !(PTR base) = P.mutableByteArrayContents buffer+              !(P.MutableByteArray mba) = buffer+              fp = ForeignPtr base (PlainPtr mba)+              offset = metaDataSize + I# unused+              finish trimmed recycled = do+                let !newSealed = BLI.Chunk trimmed oldSealed+                pure (newSealed, total, stateVar, statePtr, recycled)+              untrimmed = BI.fromForeignPtr fp offset (allocation - I# unused)+          if offset <= B.length untrimmed+            then finish untrimmed Nothing+            else finish (B.copy untrimmed) (Just buffer)++-- | Like `Proto3.Wire.Reverse.toLazyByteString` but also+-- returns the total length of the lazy 'BL.ByteString',+-- which is computed as a side effect of encoding.+runBuildR :: BuildR -> (Int, BL.ByteString)+runBuildR f = unsafePerformIO $ do+  stateVar <- newIORef undefined   -- undefined only until 'newBuffer'+  bracket (newStablePtr stateVar) freeStablePtr $ \statePtr -> do+    let u0 = smallChunkSize+    v0 <- newBuffer BL.empty 0 stateVar statePtr u0+    (v1, u1) <- fromBuildR f v0 u0+    SealedState { sealedSB = bytes, totalSB = total } <- sealBuffer v1 u1+    pure (total, bytes)++-- | First reads the number of unused bytes in the current buffer.+withUnused :: (Int -> BuildR) -> BuildR+withUnused f = toBuildR $ \v u -> fromBuildR (f u) v u++-- | First reads the number of bytes previously written.+withTotal :: (Int -> BuildR) -> BuildR+withTotal f = withTotal# (\total -> f (I# total))++-- | First reads the number of bytes previously written.+withTotal# :: (Int# -> BuildR) -> BuildR+withTotal# f = toBuildR $ \v u -> do+  I# total <- readTotal v u+  fromBuildR (f total) v u++-- | Executes the right builder, measuring how many bytes+-- it writes, then provides that figure to the left builder.+withLengthOf :: (Int -> BuildR) -> BuildR -> BuildR+withLengthOf = \f g -> withLengthOf# (\len -> f (I# len)) g+{-# INLINE CONLIKE withLengthOf #-}++-- | Executes the right builder, measuring how many bytes+-- it writes, then provides that figure to the left builder.+withLengthOf# :: (Int# -> BuildR) -> BuildR -> BuildR+withLengthOf# = \f g -> toBuildR $ \v0 u0 -> do+  !before <- readTotal v0 u0+  (v1, u1) <- fromBuildR g v0 u0+  !after <- readTotal v1 u1+  let !(I# len) = after - before+  fromBuildR (f len) v1 u1+{-# INLINE CONLIKE [1] withLengthOf# #-}  -- See Prim module for rules.++-- | Seals the current buffer and creates a new+-- one with at least the given number of bytes.+reallocate :: Int -> BuildR+reallocate (I# required) = reallocate# required++reallocate# :: Int# -> BuildR+reallocate# required = toBuildR $ \v0 u0 -> do+  SealedState+    { sealedSB = bytes+    , totalSB = total+    , stateVarSB = IORef (STRef stateVar)+    , statePtrSB = StablePtr statePtr+    } <- sealBuffer v0 u0+  let !u1 = max (I# required) defaultChunkSize+  v1 <- newBuffer bytes total (IORef (STRef stateVar)) (StablePtr statePtr) u1+  pure (v1, u1)+{-# NOINLINE reallocate# #-}  -- Avoid code bloat in library clients.++-- | Called by 'prependChunk' and 'prependReverseChunks'+-- to prepare a current buffer.+--+-- (This is a manual wrapper around 'afterPrependChunks#'.)+afterPrependChunks :: SealedState -> IO (Ptr Word8, Int)+afterPrependChunks !st = IO $ \s0 ->+  case afterPrependChunks# st s0 of+    (# v1, u1, s1 #) -> (# s1, (Ptr v1, I# u1) #)++afterPrependChunks# ::+  SealedState ->+  State# RealWorld ->+  (# Addr#, Int#, State# RealWorld #)+afterPrependChunks# SealedState+                      { sealedSB = sealed+                      , totalSB = total+                      , stateVarSB = stateVar+                      , statePtrSB = statePtr+                      , recycledSB = recycled+                      } s0 =+    case go s0 of (# s2, (Ptr v2, I# u2) #) -> (# v2, u2, s2 #)+  where+    IO go = case recycled of+      Nothing -> do+        -- The old buffer is part of 'sealed'.  Allocate a new buffer.+        let u1 = defaultChunkSize+        v1 <- newBuffer sealed total stateVar statePtr u1+        pure (v1, u1)++      Just buf -> do+        -- Recycle the old current buffer, from which+        -- we already copied what we wished to keep.+        let u1 = P.sizeofMutableByteArray buf - metaDataSize+            !(PTR base) = P.mutableByteArrayContents buf+            !v1 = plusPtr (Ptr base) (metaDataSize + u1)+            !m = plusPtr (Ptr base) metaDataSize+        writeSpace m (u1 + total)+        let !nextState = BuildRState+               { currentBuffer = buf, sealedBuffers = sealed }+        writeIORef stateVar nextState+        pure (v1, u1)++-- | Prepends a 'B.ByteString' to the output.+--+-- NOTE: This is a relatively heavyweight operation.  For small+-- strings it may be faster to copy them to the current buffer.+prependChunk :: B.ByteString -> BuildR+prependChunk (BI.PS (ForeignPtr ad ct) (I# off) (I# len))+  | I# len == 0 = mempty+  | otherwise = BuildR (\v u s -> prependChunk# v u s ad ct off len)++prependChunk# ::+  -- | Used bytes.+  Addr# ->+  -- | Count of unused bytes.+  Int# ->+  -- | State token.+  State# RealWorld ->+  -- | Base address of 'B.ByteString'.+  Addr# ->+  -- | Finalizer for 'B.ByteString'.+  ForeignPtrContents ->+  -- | Offset from base of 'B.ByteString'.+  Int# ->+  -- | Length of 'B.ByteString'.+  Int# ->+  (# Addr#, Int#, State# RealWorld #)+prependChunk# v u s ad ct off len = go v u s+  where+    BuildR go = toBuildR $ \v1 u1 -> do+      SealedState+        { sealedSB = oldSealed+        , totalSB = oldTotal+        , stateVarSB = stateVar+        , statePtrSB = statePtr+        , recycledSB = recycled+        } <- sealBuffer v1 u1++      let chunk = BI.PS (ForeignPtr ad ct) (I# off) (I# len)++      afterPrependChunks SealedState+        { sealedSB = BLI.Chunk chunk oldSealed+        , totalSB = I# len + oldTotal+        , stateVarSB = stateVar+        , statePtrSB = statePtr+        , recycledSB = recycled+        }++-- | Like 'BL.ByteString', but with the chunks in reverse order,+-- even though the bytes within each chunk are in forward order.+newtype ReverseChunks = ReverseChunks { getReverseChunks :: BL.ByteString }++-- | Equivalent to the following, but faster:+--+-- > foldMap prependChunk . reverse . getReverseChunks+--+-- NOTE: This is a relatively heavyweight operation.  For small+-- strings it may be faster to copy them to the current buffer.+prependReverseChunks :: ReverseChunks -> BuildR+prependReverseChunks (ReverseChunks BLI.Empty) = mempty+prependReverseChunks+  (ReverseChunks (BLI.Chunk (BI.PS (ForeignPtr ad ct) (I# off) (I# len)) cs)) =+  BuildR (\v u s -> prependReverseChunks# v u s ad ct off len cs)++prependReverseChunks# ::+  -- | Used bytes.+  Addr# ->+  -- | Count of unused bytes.+  Int# ->+  -- | State token.+  State# RealWorld ->+  -- | Base address of first 'B.ByteString' chunk.+  Addr# ->+  -- | Finalizer for first 'B.ByteString' chunk.+  ForeignPtrContents ->+  -- | Offset from base of first 'B.ByteString' chunk.+  Int# ->+  -- | Length of first 'B.ByteString' chunk.+  Int# ->+  -- | Other chunks.+  BL.ByteString ->+  (# Addr#, Int#, State# RealWorld #)+prependReverseChunks# v0 u0 s0 ad ct off len cs0 = go v0 u0 s0+  where+    BuildR go = toBuildR $ \v1 u1 -> do+      SealedState+        { sealedSB = oldSealed+        , totalSB = oldTotal+        , stateVarSB = stateVar+        , statePtrSB = statePtr+        , recycledSB = recycled+        } <- sealBuffer v1 u1++      let appendChunks !total sealed (BLI.Chunk c cs) =+            appendChunks (B.length c + total) (BLI.Chunk c sealed) cs+          appendChunks newTotal newSealed BLI.Empty =+            afterPrependChunks SealedState+              { sealedSB = newSealed+              , totalSB = newTotal+              , stateVarSB = stateVar+              , statePtrSB = statePtr+              , recycledSB = recycled+              }++      let rchunks = BLI.Chunk (BI.PS (ForeignPtr ad ct) (I# off) (I# len)) cs0++      appendChunks oldTotal oldSealed rchunks++-- | Ensures that the current buffer has at least the given+-- number of bytes before executing the given builder.+ensure :: Int -> BuildR -> BuildR+ensure (I# required) f = ensure# required f++ensure# :: Int# -> BuildR -> BuildR+ensure# required (BuildR f) = BuildR $ \v u s ->+  if I# required <= I# u+    then f v u s+    else let BuildR g = BuildR f <> reallocate# required in g v u s++-- | ASSUMES that the specified number of bytes is both nonnegative and+-- less than or equal to the number of unused bytes in the current buffer,+-- consumes that number of unused bytes, and provides their starting address.+unsafeConsume :: Int -> (Ptr Word8 -> IO ()) -> BuildR+unsafeConsume = \width f ->+  toBuildR $ \v0 u0 -> do+    let !m = - width+        !v1 = plusPtr v0 m+        !u1 = u0 + m+    f v1+    pure (v1, u1)+{-# INLINE unsafeConsume #-}++-- | Given the builder inputs and a 'Float', converts+-- that number to its bit pattern in native byte order.+floatToWord32 :: Ptr Word8 -> Int -> Float -> IO Word32+floatToWord32 v u x = do+  let m = metaPtr v u+  pokeByteOff m scratchOffset x+  peekByteOff m scratchOffset++-- | Given the builder inputs and a 'Double', converts+-- that number to its bit pattern in native byte order.+doubleToWord64 :: Ptr Word8 -> Int -> Double -> IO Word64+doubleToWord64 v u x = do+  let m = metaPtr v u+  pokeByteOff m scratchOffset x+  peekByteOff m scratchOffset

@@ -0,0 +1,838 @@+{-+  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.+-}++-- | Implementation details of the "Data.ByteString.Reverse" module.+-- Breaking changes will be more frequent in this module; use with caution.++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++module Proto3.Wire.Reverse.Prim+  ( -- * Combine types such as `BoundedPrim` and `FixedPrim`.+    AssocPlusNat(..)+  , CommPlusNat(..)+  , PChoose(..)+  , Max+  , AssocMaxNat(..)+  , CommMaxNat(..)++    -- * Architectural attributes.+  , StoreMethod(..)+  , storeMethod+  , ByteOrder(..)+  , systemByteOrder++    -- * Bounded primitives.+  , BoundedPrim(..)+  , liftBoundedPrim+  , composeBoundedPrim+  , unsafeBuildBoundedPrim++    -- * Fixed-width primitives.+  , FixedPrim+  , liftFixedPrim+  , word8+  , word16+  , word16Native+  , word16BE+  , word16LE+  , word32+  , word32Native+  , word32BE+  , word32LE+  , word64+  , word64Native+  , word64BE+  , word64LE+  , int8+  , int16+  , int16Native+  , int16BE+  , int16LE+  , int32+  , int32Native+  , int32BE+  , int32LE+  , int64+  , int64Native+  , int64BE+  , int64LE+  , float+  , floatNative+  , floatBE+  , floatLE+  , double+  , doubleNative+  , doubleBE+  , doubleLE+  , charUtf8+  , wordBase128LEVar+  , wordBase128LEVar_inline+  , word32Base128LEVar+  , word32Base128LEVar_inline+  , word64Base128LEVar+  , word64Base128LEVar_inline+  , vectorFixedPrim+  ) where++import           Data.Bits                     ( Bits(..) )+import           Data.Bool                     ( bool )+import           Data.Char                     ( ord )+import           Data.Int                      ( Int8, Int16, Int32, Int64 )+import           Data.Kind                     ( Type )+import qualified Data.Vector.Generic+import           Data.Word                     ( Word16,+                                                 byteSwap16, byteSwap32,+                                                 byteSwap64 )+import           Foreign                       ( Storable(..) )+import           GHC.Exts                      ( Addr#, Int#, Proxy#,+                                                 RealWorld, State#, (+#),+                                                 and#, inline, or#,+                                                 plusAddr#, plusWord#, proxy#,+                                                 uncheckedShiftRL# )+import           GHC.IO                        ( IO(..) )+import           GHC.Int                       ( Int(..) )+import           GHC.Ptr                       ( Ptr(..) )+import           GHC.TypeLits                  ( KnownNat, Nat,+                                                 type (+), natVal' )+import           GHC.Word                      ( Word(..), Word8(..),+                                                 Word32(..), Word64(..) )+import           Parameterized.Data.Semigroup  ( PNullary, PSemigroup(..),+                                                 (&<>) )+import           Parameterized.Data.Monoid     ( PMEmpty(..) )+import           Proto3.Wire.Reverse.Internal+import           Proto3.Wire.Reverse.Width     ( AssocPlusNat(..),+                                                 CommPlusNat(..),+                                                 PChoose(..),+                                                 Max, AssocMaxNat(..),+                                                 CommMaxNat(..) )++#include <MachDeps.h>  /* for WORDS_BIGENDIAN and WORD_SIZE_IN_BITS */++-- "ghc-prim" v0.6.1 defines `GHC.Prim.Ext.WORD64`, but we do not wish+-- to require that version of "ghc-prim".  Therefore we define it locally.+#if WORD_SIZE_IN_BITS < 64+import GHC.IntWord64 (Word64#)+type WORD64 = Word64#+#else+import GHC.Exts (Word#)+type WORD64 = Word#+#endif++-- $setup+-- >>> :set -XOverloadedStrings++-- | Are we restricted to aligned writes only?+data StoreMethod = StoreAligned | StoreUnaligned+  deriving (Eq, Show)++-- | 'StoreUnaligned' if the Cabal file defines @UNALIGNED_POKES@, which it+-- does on architectures where that approach is known to be safe and faster+-- then writing bytes one by one.  Otherwise 'StoreAligned'.+storeMethod :: StoreMethod+#if defined(UNALIGNED_POKES)+storeMethod = StoreUnaligned+#else+storeMethod = StoreAligned+#endif++-- | Specifies order in which the bytes of an integer are encoded.+data ByteOrder+  = BigEndian     -- ^ Most significant byte first.+  | LittleEndian  -- ^ Least significant byte first.+  deriving (Eq, Show)++-- | The 'ByteOrder' native to the current architecture.+--+-- For example, the order of the bytes when you poke a 'Word32'.+systemByteOrder :: ByteOrder+-- WORDS_BIGENDIAN is defined for big-endian architectures+-- by the GHC header <MachDeps.h>.+#if defined(WORDS_BIGENDIAN)+systemByteOrder = BigEndian+#else+systemByteOrder = LittleEndian+#endif++-- | A 'BuildR' together with a type-level bound on the number of bytes+-- written and a requirement that the current buffer already contain at+-- least that many bytes.+--+-- As in the "bytestring" package, the purpose of a bounded primitive is to+-- improve speed by consolidating the space checks of several small builders.+newtype BoundedPrim (w :: Nat) = BoundedPrim BuildR++type role BoundedPrim nominal++type instance PNullary BoundedPrim width = BoundedPrim width++instance (w1 + w2) ~ w3 =>+         PSemigroup BoundedPrim w1 w2 w3+  where+    pmappend = composeBoundedPrim+    {-# INLINE CONLIKE pmappend #-}++instance AssocPlusNat BoundedPrim u v w+  where+    assocLPlusNat = assocLPlusNatBoundedPrim+    {-# INLINE CONLIKE assocLPlusNat #-}++    assocRPlusNat = assocRPlusNatBoundedPrim+    {-# INLINE CONLIKE assocRPlusNat #-}++instance CommPlusNat BoundedPrim u v+  where+    commPlusNat _ (BoundedPrim f) = BoundedPrim f+    {-# INLINE CONLIKE commPlusNat #-}++instance PMEmpty BoundedPrim 0+  where+    pmempty = BoundedPrim mempty+    {-# INLINE CONLIKE pmempty #-}++instance Max u v ~ w =>+         PChoose BoundedPrim u v w+  where+    pbool = \(BoundedPrim f) (BoundedPrim g) -> BoundedPrim . bool f g+    {-# INLINE CONLIKE pbool #-}++instance AssocMaxNat BoundedPrim u v w+  where+    assocLMaxNat = \_ (BoundedPrim f) -> BoundedPrim f+    {-# INLINE CONLIKE assocLMaxNat #-}++    assocRMaxNat = \_ (BoundedPrim f) -> BoundedPrim f+    {-# INLINE CONLIKE assocRMaxNat #-}++instance CommMaxNat BoundedPrim u v+  where+    commMaxNat = \_ (BoundedPrim f) -> BoundedPrim f+    {-# INLINE CONLIKE commMaxNat #-}++-- | Like 'assocLPlusNat' but can be used in rules without+-- causing GHC to think the class dictionary is recursive.+assocLPlusNatBoundedPrim ::+  forall u v w .+  Proxy# '(u, v, w) -> BoundedPrim (u + (v + w)) -> BoundedPrim ((u + v) + w)+assocLPlusNatBoundedPrim = \_ (BoundedPrim f) -> BoundedPrim f+{-# INLINE CONLIKE assocLPlusNatBoundedPrim #-}++-- | Like 'assocRPlusNat' but can be used in rules without+-- causing GHC to think the class dictionary is recursive.+assocRPlusNatBoundedPrim ::+  forall u v w .+  Proxy# '(u, v, w) -> BoundedPrim ((u + v) + w) -> BoundedPrim (u + (v + w))+assocRPlusNatBoundedPrim = \_ (BoundedPrim f) -> BoundedPrim f+{-# INLINE CONLIKE assocRPlusNatBoundedPrim #-}++-- | Needed for rewrite rules; normally you would use 'pmappend' or '(&<>)'.+composeBoundedPrim :: BoundedPrim v -> BoundedPrim w -> BoundedPrim (v + w)+composeBoundedPrim =+  \(BoundedPrim f) (BoundedPrim g) -> BoundedPrim (f <> g)+{-# INLINE CONLIKE [1] composeBoundedPrim #-}++-- | Executes the bounded primitive WITHOUT first ensuring it has enough space.+unsafeBuildBoundedPrim :: BoundedPrim w -> BuildR+unsafeBuildBoundedPrim (BoundedPrim build) = build++-- | Executes the given bounded primitive+-- after obtaining the space it requires.+liftBoundedPrim :: forall w . KnownNat w => BoundedPrim w -> BuildR+liftBoundedPrim = case fromInteger (natVal' (proxy# :: Proxy# w)) of+  I# w -> unsafeLiftBoundedPrim w+{-# INLINE CONLIKE liftBoundedPrim #-}++-- | Needed for rewrite rules; normally you would use 'liftBoundedPrim'.+unsafeLiftBoundedPrim :: Int# -> BoundedPrim w -> BuildR+unsafeLiftBoundedPrim = \w (BoundedPrim f) -> ensure# w f+{-# INLINE CONLIKE [1] unsafeLiftBoundedPrim #-}++{-# RULES++"appendBuildR/unsafeLiftBoundedPrim" forall w1 w2 f1 f2 .+    appendBuildR (unsafeLiftBoundedPrim w1 f1) (unsafeLiftBoundedPrim w2 f2)+  = unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2)++"appendBuildR/unsafeLiftBoundedPrim/assoc_r" forall w1 w2 f1 f2 b .+    appendBuildR (unsafeLiftBoundedPrim w1 f1)+                 (appendBuildR (unsafeLiftBoundedPrim w2 f2) b)+  = appendBuildR (unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2)) b++"appendBuildR/unsafeLiftBoundedPrim/assoc_l" forall w1 w2 f1 f2 b .+    appendBuildR (appendBuildR b (unsafeLiftBoundedPrim w1 f1))+                 (unsafeLiftBoundedPrim w2 f2)+  = appendBuildR b (unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2))++  #-}++-- | Similar to a 'BoundedPrim' but also consolidates address updates in+-- order to take advantage of machine instructions that write at an offset.+--+-- The additional input is an offset from the current address+-- that specifies the beginning of the region being encoded.+--+-- (If GHC learns to consolidate address offsets automatically+-- then we might be able to just use 'BoundedPrim' instead.)+newtype FixedPrim (w :: Nat) = FixedPrim+  ( Addr# -> Int# -> State# RealWorld -> Int# ->+    (# Addr#, Int#, State# RealWorld #)+  )++type role FixedPrim nominal++type instance PNullary FixedPrim width = FixedPrim width++instance ((w1 + w2) ~ w3, KnownNat w1) =>+         PSemigroup FixedPrim w1 w2 w3+  where+    pmappend = \(FixedPrim f) (FixedPrim g) ->+      case fromInteger (natVal' (proxy# :: Proxy# w1)) of+        I# w1 -> FixedPrim+          ( \v0 u0 s0 o -> case g v0 u0 s0 (o +# w1) of+             (# v1, u1, s1 #) -> f v1 u1 s1 o )+    {-# INLINE CONLIKE pmappend #-}++instance AssocPlusNat FixedPrim u v w+  where+    assocLPlusNat = \_ (FixedPrim f) -> FixedPrim f+    {-# INLINE CONLIKE assocLPlusNat #-}++    assocRPlusNat = \_ (FixedPrim f) -> FixedPrim f+    {-# INLINE CONLIKE assocRPlusNat #-}++instance CommPlusNat FixedPrim u v+  where+    commPlusNat = \_ (FixedPrim f) -> FixedPrim f+    {-# INLINE CONLIKE commPlusNat #-}++instance PMEmpty FixedPrim 0+  where+    pmempty = FixedPrim (\v u s _ -> (# v, u, s #))+    {-# INLINE CONLIKE pmempty #-}++-- | Executes the given fixed primitive and adjusts the current address.+liftFixedPrim :: forall w . KnownNat w => FixedPrim w -> BoundedPrim w+liftFixedPrim = \(FixedPrim f) -> BoundedPrim (BuildR (g f))+  where+    !(I# o) = - fromInteger (natVal' (proxy# :: Proxy# w))+    g = \f v0 u0 s0 -> case f v0 u0 s0 o of+      (# v1, u1, s1 #) -> (# plusAddr# v1 o, u1 +# o, s1 #)+    {-# INLINE g #-}+{-# INLINE CONLIKE [1] liftFixedPrim #-}++{-# RULES++"composeBoundedPrim/liftFixedPrim"+    forall (f1 :: KnownNat w1 => FixedPrim w1)+           (f2 :: KnownNat (w1 + w2) => FixedPrim w2).+    composeBoundedPrim (liftFixedPrim f1) (liftFixedPrim f2)+  = liftFixedPrim (pmappend f1 f2)++"composeBoundedPrim/liftFixedPrim/assoc_r"+    forall (f1 :: KnownNat w1 => FixedPrim w1)+           (f2 :: KnownNat (w1 + w2) => FixedPrim w2)+           (b3 :: BoundedPrim w3) .+    composeBoundedPrim (liftFixedPrim f1)+                       (composeBoundedPrim (liftFixedPrim f2) b3)+  = assocRPlusNatBoundedPrim (proxy# :: Proxy# '(w1, w2, w3))+      (composeBoundedPrim (liftFixedPrim (pmappend f1 f2)) b3)++"composeBoundedPrim/liftFixedPrim/assoc_l"+    forall (b1 :: BoundedPrim w1)+           (f2 :: KnownNat w2 => FixedPrim w2)+           (f3 :: KnownNat (w2 + w3) => FixedPrim w3) .+    composeBoundedPrim (composeBoundedPrim b1 (liftFixedPrim f2))+                       (liftFixedPrim f3)+  = assocLPlusNatBoundedPrim (proxy# :: Proxy# '(w1, w2, w3))+      (composeBoundedPrim b1 (liftFixedPrim (pmappend f2 f3)))++"withLengthOf#/unsafeLiftBoundedPrim/liftFixedPrim" forall f w g .+    withLengthOf# f (unsafeLiftBoundedPrim w (liftFixedPrim g))+  = appendBuildR (f w) (unsafeLiftBoundedPrim w (liftFixedPrim g))++  #-}++-- | Required:+--+-- > fromInteger (natVal' (proxy# :: Proxy# (StorableWidth a))) =+-- >   sizeOf (undefined :: x)+type family StorableWidth (a :: Type) :: Nat++type instance StorableWidth Word8 = 1+type instance StorableWidth Word16 = 2+type instance StorableWidth Word32 = 4+type instance StorableWidth Word64 = 8++type instance StorableWidth Int8 = 1+type instance StorableWidth Int16 = 2+type instance StorableWidth Int32 = 4+type instance StorableWidth Int64 = 8++type instance StorableWidth Float = 4+type instance StorableWidth Double = 8++-- | WARNING: The write may be unaligned; check 'storeMethod' first.+primPoke :: Storable x => x -> FixedPrim (StorableWidth x)+primPoke !x = FixedPrim p+  where+    p v u s0 o =+      let IO q = pokeByteOff (Ptr v) (I# o) x+      in case q s0 of (# s1, (_ :: ()) #) -> (# v, u, s1 #)++-- | Fixed-width primitive that writes a single byte as-is.+word8 :: Word8 -> FixedPrim 1+word8 = primPoke+  -- Byte order and alignment do not matter for a single byte.++-- | Shifts right by @s@ bits, then writes the least significant byte.+word8Shift :: Int -> Word -> FixedPrim 1+word8Shift s x = word8 (fromIntegral (shiftR x s))++-- | Shifts right by @s@ bits, then writes the least significant 16-bit word.+word16Shift :: ByteOrder -> Int -> Word -> FixedPrim 2+word16Shift bo = case bo of+    BigEndian    -> \(!s) (!x) -> p (s + h) x &<> p s x+    LittleEndian -> \(!s) (!x) -> p s x &<> p (s + h) x+  where+    h = 8+    p = word8Shift++-- | Writes the least significant 32-bit word, one byte at a time.+word32Shift :: ByteOrder -> Word -> FixedPrim 4+word32Shift bo = case bo of+    BigEndian    -> \(!x) -> p h x &<> p 0 x+    LittleEndian -> \(!x) -> p 0 x &<> p h x+  where+    h = 16+    p = word16Shift bo++-- | Writes one byte at a time.+word64Shift :: ByteOrder -> Word64 -> FixedPrim 8+word64Shift bo = case bo of+    BigEndian    -> \(!x) -> p (h x) &<> p x+    LittleEndian -> \(!x) -> p x &<> p (h x)+  where+    h x = shiftR x 32+    p = word32Shift bo . fromIntegral @Word64 @Word++-- | Fixed-width primitive that writes a 16-bit word+-- in the specified byte order.+word16 :: ByteOrder -> Word16 -> FixedPrim 2+word16 !bo !x = case storeMethod of+  StoreAligned -> word16Shift bo 0 (fromIntegral x)+  StoreUnaligned+    | systemByteOrder == bo -> primPoke x+    | otherwise -> primPoke (byteSwap16 x)++-- | Fixed-width primitive that writes a 16-bit word+-- in native byte order.+word16Native :: Word16 -> FixedPrim 2+word16Native = word16 systemByteOrder++-- | Fixed-width primitive that writes a 16-bit word+-- in big-endian byte order.+word16BE :: Word16 -> FixedPrim 2+word16BE = word16 BigEndian++-- | Fixed-width primitive that writes a 16-bit word+-- in little-endian byte order.+word16LE :: Word16 -> FixedPrim 2+word16LE = word16 LittleEndian++-- | Fixed-width primitive that writes a 32-bit word+-- in the specified byte order.+word32 :: ByteOrder -> Word32 -> FixedPrim 4+word32 !bo !x = case storeMethod of+  StoreAligned -> word32Shift bo (fromIntegral x)+  StoreUnaligned+    | systemByteOrder == bo -> primPoke x+    | otherwise -> primPoke (byteSwap32 x)++-- | Fixed-width primitive that writes a 32-bit word+-- in native byte order.+word32Native :: Word32 -> FixedPrim 4+word32Native = word32 systemByteOrder++-- | Fixed-width primitive that writes a 32-bit word+-- in big-endian byte order.+word32BE :: Word32 -> FixedPrim 4+word32BE = word32 BigEndian++-- | Fixed-width primitive that writes a 32-bit word+-- in little-endian byte order.+word32LE :: Word32 -> FixedPrim 4+word32LE = word32 LittleEndian++-- | Fixed-width primitive that writes a 64-bit word+-- in the specified byte order.+word64 :: ByteOrder -> Word64 -> FixedPrim 8+word64 !bo !x = case storeMethod of+  StoreAligned -> word64Shift bo (fromIntegral x)+  StoreUnaligned+    | systemByteOrder == bo -> primPoke x+    | otherwise -> primPoke (byteSwap64 x)++-- | Fixed-width primitive that writes a 64-bit word+-- in native byte order.+word64Native :: Word64 -> FixedPrim 8+word64Native = word64 systemByteOrder++-- | Fixed-width primitive that writes a 64-bit word+-- in big-endian byte order.+word64BE :: Word64 -> FixedPrim 8+word64BE = word64 BigEndian++-- | Fixed-width primitive that writes a 64-bit word+-- in little-endian byte order.+word64LE :: Word64 -> FixedPrim 8+word64LE = word64 LittleEndian++-- | @'word8' . 'fromIntegral'@+int8 :: Int8 -> FixedPrim 1+int8 = word8 . fromIntegral++-- | @\bo -> 'word16' bo . 'fromIntegral'@+int16 :: ByteOrder -> Int16 -> FixedPrim 2+int16 !bo = word16 bo . fromIntegral++-- | @'word16Native' . 'fromIntegral'@+int16Native :: Int16 -> FixedPrim 2+int16Native = word16Native . fromIntegral++-- | @'word16BE' . 'fromIntegral'@+int16BE :: Int16 -> FixedPrim 2+int16BE = word16BE . fromIntegral++-- | @'word16LE' . 'fromIntegral'@+int16LE :: Int16 -> FixedPrim 2+int16LE = word16LE . fromIntegral++-- | @\bo -> 'word32' bo . 'fromIntegral'@+int32 :: ByteOrder -> Int32 -> FixedPrim 4+int32 bo = word32 bo . fromIntegral++-- | @'word32Native' . 'fromIntegral'@+int32Native :: Int32 -> FixedPrim 4+int32Native = word32Native . fromIntegral++-- | @'word32BE' . 'fromIntegral'@+int32BE :: Int32 -> FixedPrim 4+int32BE = word32BE . fromIntegral++-- | @'word32LE' . 'fromIntegral'@+int32LE :: Int32 -> FixedPrim 4+int32LE = word32LE . fromIntegral++-- | @\bo -> 'word64' bo . 'fromIntegral'@+int64 :: ByteOrder -> Int64 -> FixedPrim 8+int64 bo = word64 bo . fromIntegral++-- | @'word64Native' . 'fromIntegral'@+int64Native :: Int64 -> FixedPrim 8+int64Native = word64Native . fromIntegral++-- | @'word64BE' . 'fromIntegral'@+int64BE :: Int64 -> FixedPrim 8+int64BE = word64BE . fromIntegral++-- | @'word64LE' . 'fromIntegral'@+int64LE :: Int64 -> FixedPrim 8+int64LE = word64LE . fromIntegral++-- | Fixed-width primitive that writes a 'Float'+-- in the specified byte order.+float :: ByteOrder -> Float -> FixedPrim 4+float BigEndian = floatBE+float LittleEndian = floatLE++-- | Fixed-width primitive that writes a 'Float'+-- in native byte order.+floatNative :: Float -> FixedPrim 4+floatNative = float systemByteOrder++-- | Fixed-width primitive that writes a 'Float'+-- in big-endian byte order.+floatBE :: Float -> FixedPrim 4+floatBE !x = FixedPrim g+  where+    g v u s0 o = case floatToWord32 (Ptr v) (I# u) x of+      IO h -> case h s0 of+        (# s1, y #) ->+          let FixedPrim f = word32BE y+          in f v u s1 o++-- | Fixed-width primitive that writes a 'Float'+-- in little-endian byte order.+floatLE :: Float -> FixedPrim 4+floatLE !x = FixedPrim g+  where+    g v u s0 o = case floatToWord32 (Ptr v) (I# u) x of+      IO h -> case h s0 of+        (# s1, y #) ->+          let FixedPrim f = word32LE y+          in f v u s1 o++-- | Fixed-width primitive that writes a 'Double'+-- in the specified byte order.+double :: ByteOrder -> Double -> FixedPrim 8+double BigEndian = doubleBE+double LittleEndian = doubleLE++-- | Fixed-width primitive that writes a 'Double'+-- in native byte order.+doubleNative :: Double -> FixedPrim 8+doubleNative = double systemByteOrder++-- | Fixed-width primitive that writes a 'Double'+-- in big-endian byte order.+doubleBE :: Double -> FixedPrim 8+doubleBE !x = FixedPrim g+  where+    g v u s0 o = case doubleToWord64 (Ptr v) (I# u) x of+      IO h -> case h s0 of+        (# s1, y #) ->+          let FixedPrim f = word64BE y+          in f v u s1 o++-- | Fixed-width primitive that writes a 'Double'+-- in little-endian byte order.+doubleLE :: Double -> FixedPrim 8+doubleLE !x = FixedPrim g+  where+    g v u s0 o = case doubleToWord64 (Ptr v) (I# u) x of+      IO h -> case h s0 of+        (# s1, y #) ->+          let FixedPrim f = word64LE y+          in f v u s1 o++-- | Bounded-width primitive that writes a 'Char'+-- according to the UTF-8 encoding.+charUtf8 :: Char -> BoundedPrim 4+charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x+  where+    wordUtf8 :: Word# -> BoundedPrim 4+    wordUtf8 =+      choose 0x7F p1 $+      choose 0x7FF p2 $+      choose 0xFFFF p3 $+      (\y -> liftFixedPrim (p4 y))+    {-# INLINE wordUtf8 #-}++    choose ::+      forall v w .+      (KnownNat v, KnownNat w) =>+      Word ->+      (Word# -> FixedPrim v) ->+      (Word# -> BoundedPrim w) ->+      Word# -> BoundedPrim (Max w v)+    choose = \t f g x -> pif (W# x <= t) (liftFixedPrim (f x)) (g x)+      -- We have observed GHC v8.6.5 jumping on the 'False' branch+      -- and falling through on the 'True' branch.  We set up our+      -- condition to favor lower character codes.+    {-# INLINE choose #-}++    lsb ::+      KnownNat n =>+      (Word# -> FixedPrim n) ->+      Word# ->+      FixedPrim (n + 1)+    lsb = \p x -> p (uncheckedShiftRL# x 6#) &<>+                  word8 (W8# (plusWord# 0x80## (and# x 0x3F##)))+    {-# INLINE lsb #-}++    p1 :: Word# -> FixedPrim 1+    p2 :: Word# -> FixedPrim 2+    p3 :: Word# -> FixedPrim 3+    p4 :: Word# -> FixedPrim 4++    p1 x = word8 (W8# x)+    p2 = lsb (\x -> word8 (W8# (plusWord# 0xC0## x)))+    p3 = lsb (lsb (\x -> word8 (W8# (plusWord# 0xE0## x))))+    p4 = lsb (lsb (lsb (\x -> word8 (W8# (plusWord# 0xF0## x)))))++    {-# INLINE p1 #-}+    {-# INLINE p2 #-}+    {-# INLINE p3 #-}+    {-# INLINE p4 #-}+{-# INLINE charUtf8 #-}++-- | The bounded primitive implementing+-- `Proto3.Wire.Reverse.wordBase128LEVar`.+#if WORD_SIZE_IN_BITS < 64+wordBase128LEVar :: Word -> BoundedPrim 5+wordBase128LEVar (W# w) = word32Base128LEVar (W32# w)+#else+wordBase128LEVar :: Word -> BoundedPrim 10+wordBase128LEVar (W# w) = word64Base128LEVar (W64# w)+#endif+{-# INLINE wordBase128LEVar #-}++-- | Like 'wordBase128LEVar' but inlined, possibly bloating your code.  On+-- the other hand, inlining an application to a constant may shrink your code.+#if WORD_SIZE_IN_BITS < 64+wordBase128LEVar_inline :: Word -> BoundedPrim 5+wordBase128LEVar_inline (W# w) = word32Base128LEVar_inline (W32# w)+#else+wordBase128LEVar_inline :: Word -> BoundedPrim 10+wordBase128LEVar_inline (W# w) = word64Base128LEVar_inline (W64# w)+#endif+{-# INLINE wordBase128LEVar_inline #-}++-- | The bounded primitive implementing+-- `Proto3.Wire.Reverse.word32Base128LEVar`.+word32Base128LEVar :: Word32 -> BoundedPrim 5+word32Base128LEVar = word32Base128LEVar_inline+{-# INLINE word32Base128LEVar #-}++-- | Like 'word32Base128LEVar' but inlined, which currently means+-- that it is just the same as 'word32Base128LEVar', which we inline.+word32Base128LEVar_inline :: Word32 -> BoundedPrim 5+word32Base128LEVar_inline = \(W32# x0) ->+  ( wordBase128LEVar_choose 1 wordBase128LE_p1 $+    wordBase128LEVar_choose 2 wordBase128LE_p2 $+    wordBase128LEVar_choose 3 wordBase128LE_p3 $+    wordBase128LEVar_choose 4 wordBase128LE_p4 $+    (\x -> liftFixedPrim (wordBase128LE_p5 0## x))+  ) x0+{-# INLINE word32Base128LEVar_inline #-}++wordBase128LEVar_choose ::+  forall v w .+  (KnownNat v, KnownNat w) =>+  Int ->+  (Word# -> Word# -> FixedPrim v) ->+  (Word# -> BoundedPrim w) ->+  Word# -> BoundedPrim (Max w v)+wordBase128LEVar_choose = \d f g x ->+  pif (W# x <= shiftL 1 (7 * d) - 1) (liftFixedPrim (f 0## x)) (g x)+  -- We have observed GHC v8.6.5 jumping on the 'False' branch+  -- and falling through on the 'True' branch.  We set up our+  -- condition to favor lower numeric values.+{-# INLINE wordBase128LEVar_choose #-}++wordBase128LE_msb ::+  forall n .+  KnownNat n =>+  (Word# -> Word# -> FixedPrim n) ->+  Word# -> Word# -> FixedPrim (n + 1)+wordBase128LE_msb = \p m x ->+    p 0x80## x &<> word8 (W8# (or# m (uncheckedShiftRL# x s)))+  where+    !(I# s) = 7 * fromInteger (natVal' (proxy# :: Proxy# n))+{-# INLINE wordBase128LE_msb #-}++wordBase128LE_p1 :: Word# -> Word# -> FixedPrim 1+wordBase128LE_p1 = \m x -> word8 (W8# (or# m x))+{-# INLINE wordBase128LE_p1 #-}++wordBase128LE_p2 :: Word# -> Word# -> FixedPrim 2+wordBase128LE_p2 = wordBase128LE_msb wordBase128LE_p1+{-# INLINE wordBase128LE_p2 #-}++wordBase128LE_p3 :: Word# -> Word# -> FixedPrim 3+wordBase128LE_p3 = wordBase128LE_msb wordBase128LE_p2+{-# INLINE wordBase128LE_p3 #-}++wordBase128LE_p4 :: Word# -> Word# -> FixedPrim 4+wordBase128LE_p4 = wordBase128LE_msb wordBase128LE_p3+{-# INLINE wordBase128LE_p4 #-}++wordBase128LE_p5 :: Word# -> Word# -> FixedPrim 5+wordBase128LE_p5 = wordBase128LE_msb wordBase128LE_p4+{-# INLINE wordBase128LE_p5 #-}++-- | Writes 1 or 2 base-128 digits in little-endian order;+-- in the 2-digit case the high bit of the containing byte of+-- the low digit is set, and the other byte has a clear high bit.+--+-- WARNING: The argument is ASSUMED to be in [0 .. 2^14 - 1].+word14Base128LEVar :: Word# -> BoundedPrim 2+word14Base128LEVar = \x0 ->+  ( wordBase128LEVar_choose 1 wordBase128LE_p1 $+    (\x -> liftFixedPrim (wordBase128LE_p2 0## x))+  ) x0+{-# INLINE word14Base128LEVar #-}++-- | Writes four base-128 digits, one per byte, with+-- the high bit of each byte set, in little-endian order.+--+-- There is no requirement that the argument be @< 2^28@.+word28Base128LE :: Word# -> FixedPrim 4+word28Base128LE = wordBase128LE_p4 0x80##+{-# INLINE word28Base128LE #-}++-- | The bounded primitive implementing+-- `Proto3.Wire.Reverse.word64Base128LEVar`.+word64Base128LEVar :: Word64 -> BoundedPrim 10+word64Base128LEVar = \(W64# x) ->+    pif (W64# x <= fromIntegral (maxBound :: Word32))+          (word32Base128LEVar (fromIntegral (W64# x)))+          (word64Base128LEVar_big x)+{-# INLINE word64Base128LEVar #-}++-- | Like 'word64Base128LEVar' but inlined, possibly bloating your code.  On+-- the other hand, inlining an application to a constant may shrink your code.+word64Base128LEVar_inline :: Word64 -> BoundedPrim 10+word64Base128LEVar_inline = \(W64# x) ->+    pif (W64# x <= fromIntegral (maxBound :: Word32))+          (word32Base128LEVar (fromIntegral (W64# x)))+          (inline (word64Base128LEVar_big x))+{-# INLINE word64Base128LEVar_inline #-}++-- | The input must be at least 2^32.+word64Base128LEVar_big :: WORD64 -> BoundedPrim 10+word64Base128LEVar_big x = pif (W64# x <= shiftL 1 60 - 1) p60 p64+  where+    p60 = liftFixedPrim (word28Base128LE x32) &<>+          word32Base128LEVar (W32# (shR 28))++    p64 = ( liftFixedPrim (word28Base128LE x32) &<>+            liftFixedPrim (word28Base128LE (shR 28)) ) &<>+          word14Base128LEVar (shR 56)++    x32 = case fromIntegral (W64# x) of W32# y -> y++    shR s = case fromIntegral (shiftR (W64# x) s) of W32# y -> y+{-# NOINLINE word64Base128LEVar_big #-}++-- | The analog of `Proto3.Wire.Reverse.vectorBuildR` for when fixed-width+-- primitives encode the elements of the vector.  In this special case we+-- can predict the overall length.+vectorFixedPrim ::+  forall w v a .+  (KnownNat w, Data.Vector.Generic.Vector v a) =>+  (a -> FixedPrim w) ->+  v a ->+  BuildR+vectorFixedPrim f = etaBuildR $ \v ->+    let op acc x = acc <> unsafeBuildBoundedPrim (liftFixedPrim (f x))+    in ensure (w * Data.Vector.Generic.length v) (foldlRVector op mempty v)+  where+    w = fromInteger (natVal' (proxy# :: Proxy# w))+{-# INLINE vectorFixedPrim #-}

@@ -0,0 +1,113 @@+{-+  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.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++-- | Augmentations to type classes such as 'Semigroup' and 'Monoid' that may+-- be used to track the type-level width information of builder primitives.+module Proto3.Wire.Reverse.Width+  ( AssocPlusNat(..)+  , CommPlusNat(..)+  , PChoose(..)+  , Max+  , AssocMaxNat(..)+  , CommMaxNat(..)+  ) where++import Data.Type.Bool (If)+import GHC.Exts (Proxy#)+import GHC.TypeLits (type (<=?), type (+))+import Parameterized.Data.Semigroup (PNullary)++-- | Associativity of '+' in type parameters.+class AssocPlusNat n u v w+  where+    assocLPlusNat ::+      Proxy# '(u, v, w) ->+      PNullary n (u + (v + w)) ->+      PNullary n ((u + v) + w)++    assocRPlusNat ::+      Proxy# '(u, v, w) ->+      PNullary n ((u + v) + w) ->+      PNullary n (u + (v + w))++-- | Commutativity of '+' in type parameters.+class CommPlusNat n u v+  where+    commPlusNat ::+      Proxy# '(u, v) ->+      PNullary n (u + v) ->+      PNullary n (v + u)++-- | Chooses between alternatives based on a condition,+-- adjusting a type-level parameter appropriately.+--+-- Note that while this type class makes sense for bounded builder primitives,+-- it should not be instantiated for fixed-width primitives of differing+-- widths (at least, not without padding to equalize the widths) because+-- the choice between alternatives introduces a run-time variation in width.+-- Instead please use ordinary `Data.Bool.bool` or @if _ then _ else _@.+class PChoose n f t w | f t -> w+  where+    -- | Like `Data.Bool.bool`, chooses the first argument on 'False'+    -- and the second on 'True', either way promoting the type-level+    -- `GHC.TypeLits.Nat` to the larger of the given `GHC.TypeLits.Nat`s.+    --+    -- Defaults to the natural implementation in terms of 'pif'.+    pbool :: PNullary n f -> PNullary n t -> Bool -> PNullary n w+    pbool f t b = pif b t f+    {-# INLINE CONLIKE pbool #-}++    -- | Like @if _ then _ else@, chooses the first argument on 'True'+    -- and the second on 'False', either way promoting the type-level+    -- `GHC.TypeLits.Nat` to the larger of the given `GHC.TypeLits.Nat`s.+    --+    -- Defaults to the natural implementation in terms of 'pbool'.+    pif :: Bool -> PNullary n t -> PNullary n f -> PNullary n w+    pif c t e = pbool e t c+    {-# INLINE CONLIKE pif #-}++    {-# MINIMAL pbool | pif #-}++-- | The larger of two `GHC.TypeLits.Nat`s.+type Max u v = If (v <=? u) u v++-- | Associativity of 'Max' in type parameters.+class AssocMaxNat n u v w+  where+    assocLMaxNat ::+      Proxy# '(u, v, w) ->+      PNullary n (Max u (Max v w)) ->+      PNullary n (Max (Max u v) w)++    assocRMaxNat ::+      Proxy# '(u, v, w) ->+      PNullary n (Max (Max u v) w) ->+      PNullary n (Max u (Max v w))++-- | Commutativity of 'Max' in type parameters.+class CommMaxNat n u v+  where+    commMaxNat ::+      Proxy# '(u, v) ->+      PNullary n (Max u v) ->+      PNullary n (Max v u)

@@ -17,8 +17,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -Wno-warnings-deprecations #-}+ module Main where +import           Control.Arrow         ( (&&&), first, second )+import           Control.Monad         ( guard, void )+import           Control.Monad.Trans.State ( StateT(..) )+import qualified Data.Bits             as Bits import qualified Data.ByteString       as B import qualified Data.ByteString.Lazy  as BL import qualified Data.ByteString.Builder.Internal as BBI@@ -26,10 +32,16 @@ import           Data.Maybe            ( fromMaybe ) import           Data.Monoid           ( (<>) ) import           Data.Int+import           Data.List             ( group ) import qualified Data.Text.Lazy        as T+import qualified Data.Vector           as V+import           Data.Word             ( Word8, Word64 )+import           Foreign               ( sizeOf )  import           Proto3.Wire import qualified Proto3.Wire.Builder   as Builder+import qualified Proto3.Wire.Reverse   as Reverse+import qualified Proto3.Wire.Reverse.Prim as Prim import qualified Proto3.Wire.Encode    as Encode import qualified Proto3.Wire.Decode    as Decode @@ -44,7 +56,9 @@ main = do     Test.DocTest.doctest       [ "-isrc"+      , "-fobject-code"       , "src/Proto3/Wire/Builder.hs"+      , "src/Proto3/Wire/Reverse.hs"       , "src/Proto3/Wire/Encode.hs"       , "src/Proto3/Wire/Decode.hs"       ]@@ -53,8 +67,12 @@ tests :: TestTree tests = testGroup "Tests" [ roundTripTests                           , buildSingleChunk+                          , buildRBufferSizes+                          , strictByteString+                          , lazyByteString                           , decodeNonsense                           , varIntHeavyTests+                          , packedLargeTests                           ]  data StringOrInt64 = TString T.Text | TInt64 Int64@@ -63,7 +81,7 @@ instance QC.Arbitrary StringOrInt64 where     arbitrary = QC.oneof [ TString . T.pack <$> QC.arbitrary, TInt64 <$> QC.arbitrary ] --- this just stress tesses the fancy varint encodings with more randomness+-- This just stress tests the fancy varint encodings with more randomness. varIntHeavyTests :: TestTree varIntHeavyTests = adjustOption (const $ QC.QuickCheckTests 10000) $                             roundTrip "varInt uint test"@@ -123,14 +141,46 @@                                                                    0 `at`                                                                    fieldNumber 1))                                             `at` fieldNumber 1)-                           , roundTrip "embeddedList"+                           , roundTrip "embeddedListPackedVarints"                                        (Encode.embedded (fieldNumber 1) .+                                            Encode.packedVarints (fieldNumber 1))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 1))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFixed32"+                                       (Encode.embedded (fieldNumber 1) .                                             Encode.packedFixed32 (fieldNumber 1))                                        (fmap (fromMaybe [0,1,2,3,4])                                              (Decode.embedded (one Decode.packedFixed32 []                                                                    `at`                                                                    fieldNumber 1))                                             `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFixed64"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedFixed64 (fieldNumber 1))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedFixed64 []+                                                                   `at`+                                                                   fieldNumber 1))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFloats"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedFloats (fieldNumber 1))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedFloats []+                                                                   `at`+                                                                   fieldNumber 1))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedDoubles"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedDoubles (fieldNumber 1))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedDoubles []+                                                                   `at`+                                                                   fieldNumber 1))+                                            `at` fieldNumber 1)                            , roundTrip "embeddedListUnpacked"                                        (Encode.embedded (fieldNumber 1) .                                             (foldMap . Encode.int32) (fieldNumber 1))@@ -185,7 +235,7 @@                 Right x' -> x === x'  buildSingleChunk :: TestTree-buildSingleChunk = HU.testCase "Builder creates a single chunk" $ do+buildSingleChunk = HU.testCase "Legacy Builder creates a single chunk" $ do   let chunks = length . BL.toChunks . Builder.toLazyByteString        huge = B.replicate (BBI.maximalCopySize + 16) 1@@ -197,7 +247,486 @@   HU.assertBool "single chunk (strict)" $ chunks huge2 == 1   HU.assertBool "single chunk (lazy)" $ chunks hugeL2 == 1 +parseBytes :: Int64 -> StateT BL.ByteString Maybe BL.ByteString+parseBytes n = StateT $ \bl -> do+  let (before, after) = BL.splitAt n bl+  guard (BL.length before == n)+  pure (before, after)++-- | Parses a big-endian 64-bit unsigned integer.+parseWord64BE :: StateT BL.ByteString Maybe Word64+parseWord64BE = do+  let be n bl = maybe n (j n) (BL.uncons bl)+      j n (h, t) = be (256 * n + fromIntegral h) t+  be 0 <$> parseBytes 8++-- | Consumes and returns the longest prefix whose bytes+-- all satisfy the given predicate.  Never fails.+parseWhile :: (Word8 -> Bool) -> StateT BL.ByteString Maybe BL.ByteString+parseWhile p = StateT (Just . BL.span p)++-- | Run-length encode lazy a 'BL.ByteString'+-- for concise display in test results.+rle :: BL.ByteString -> [(Int, Word8)]+rle = map (length &&& head) . group . BL.unpack++-- | Please adjust this expected size of the metadata header+-- to match that expected of the current implementation.+buildRMeta :: Int+buildRMeta = 2 * sizeOf (undefined :: Word) + sizeOf (undefined :: Double)++buildRSmallChunkSize :: Int+buildRSmallChunkSize = BBI.smallChunkSize - buildRMeta++buildRDefaultChunkSize :: Int+buildRDefaultChunkSize = BBI.defaultChunkSize - buildRMeta++-- | Encodes the given 64-bit unsigned integer in big-endian format.+encodeWord64BE :: Word64 -> B.ByteString+encodeWord64BE = B.pack . go 8+  where+    go n w+      | n <= 0 = []+      | otherwise = fromIntegral (Bits.shiftR w (8 * (n - 1))) : go (n - 1) w++-- | Writes the given byte into all the previously-unused+-- bytes in the current buffer.+fillUnused :: Word8 -> Reverse.BuildR+fillUnused = fillUnusedExcept 0++-- | Like 'fillUnused', but writes fewer bytes in order to leave+-- the specified number of bytes unused, unless we start with fewer,+-- in which case there is no change at all.+fillUnusedExcept :: Int -> Word8 -> Reverse.BuildR+fillUnusedExcept unusedRemaining w8 = Reverse.testWithUnused $ \u ->+  foldMap (const (Reverse.word8 w8)) [unusedRemaining + 1 .. u]+{-# NOINLINE fillUnusedExcept #-}+   -- In case rewrite rules would interfere with buffer boundaries,+   -- which may be fine normally, we forbid inlining of this probe.++buildRBufferSizes :: TestTree+buildRBufferSizes = HU.testCase "BuildR buffer sizes" $ do+  let builder1 m = Reverse.ensure (max 8 m) $ Reverse.testWithUnused $ \u ->+        Reverse.word64BE (fromIntegral u) <> fillUnusedExcept 8 7+      {-# NOINLINE builder1 #-}++  let builder3 =+        builder1 (buildRDefaultChunkSize + 1) <> builder1 0 <> builder1 0++  let encodedBytes :: BL.ByteString+      encodedBytes = Reverse.toLazyByteString builder3++  let parseBuffer :: StateT BL.ByteString Maybe Word64+      parseBuffer = do+        n <- parseWord64BE+        _ <- parseBytes (max 0 (fromIntegral n - 8))+        pure n++  let parseBuffer3 :: StateT BL.ByteString Maybe (Word64, Word64, Word64)+      parseBuffer3 = do+        x <- parseBuffer+        y <- parseBuffer+        z <- parseBuffer+        pure (x, y, z)++  let actual, expected :: Maybe ((Word64, Word64, Word64), [(Int, Word8)])+      actual = second rle <$> runStateT parseBuffer3 encodedBytes+      expected = Just ((t, s, f), [])+                   -- We build in reverse but parser forward; therefore+                   -- the initial allocation is the final component.+        where+          t = fromIntegral buildRDefaultChunkSize + 1+          s = fromIntegral buildRDefaultChunkSize+          f = fromIntegral buildRSmallChunkSize++  let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)+  HU.assertEqual msg expected actual++strictByteString :: TestTree+strictByteString = HU.testCase "Strict ByteString BuildR" $ do+  -- Because the initial buffer has a distinctive size we can use+  -- to distinguish it from other buffers, we start with a string+  -- that does not fit in that buffer, so that we can check that+  -- the buffer is reused as-is after those strings, not reallocated.+  let builder1 = Reverse.testWithUnused $ \u -> Reverse.byteString $+        B.replicate (buildRSmallChunkSize + 1) 10 <>+        encodeWord64BE (fromIntegral u)+      {-# NOINLINE builder1 #-}++  -- Then we write strings that do fit within the initial buffer.+  let builder2 = Reverse.testWithUnused $ \u -> Reverse.byteString $+        B.replicate 3 20 <> encodeWord64BE (fromIntegral u)+      {-# NOINLINE builder2 #-}++  let builder3 = Reverse.testWithUnused $ \u -> Reverse.byteString $+        B.replicate 3 30 <> encodeWord64BE (fromIntegral u)+      {-# NOINLINE builder3 #-}++  -- Then we check the just-enough-room case, which incidentally+  -- ensures that we use enough of the initial buffer that it+  -- will not be recycled.+  let builder4 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     B.replicate 3 40 <> encodeWord64BE (fromIntegral u) )+                 <> fillUnusedExcept 11 (0xD0 - 4) <>+                 ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder4 #-}++  -- Then the case of the almost-full-buffer with not quite enough room.+  let builder5 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     B.replicate 3 50 <> encodeWord64BE (fromIntegral u) )+                 <> fillUnusedExcept 10 (0xD0 - 5) <>+                 ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder5 #-}++  -- Then the full-buffer case.+  let builder6 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     B.replicate 3 60 <> encodeWord64BE (fromIntegral u) )+                 <> fillUnused (0xD0 - 6) <>+                 ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder6 #-}++  -- Check final unused.+  let builder7 = ( Reverse.testWithUnused $ \u -> Reverse.byteString $+                     B.replicate 3 70 <> encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder7 #-}++  let buildAll = builder7 <> builder6 <> builder5 <>+                 builder4 <> builder3 <> builder2 <> builder1++  let encodedBytes :: BL.ByteString+      encodedBytes = Reverse.toLazyByteString buildAll++  let parseFixed :: Int64 -> Word8 -> StateT BL.ByteString Maybe ()+      parseFixed n w = do+        bl <- parseBytes n+        guard (BL.all (w ==) bl)++  let parsePad :: Word8 -> StateT BL.ByteString Maybe ()+      parsePad = void . parseWhile . (==)++  let parseAll :: StateT BL.ByteString Maybe+                         ( Word64, (Word64, Word64), (Word64, Word64),+                           (Word64, Word64), Word64, Word64, Word64 )+      parseAll = do+        parseFixed 3 70+        u7 <- parseWord64BE++        parseFixed 3 60+        u6B <- parseWord64BE+        parsePad (0xD0 - 6)+        u6A <- parseWord64BE++        parseFixed 3 50+        u5B <- parseWord64BE+        parsePad (0xD0 - 5)+        u5A <- parseWord64BE++        parseFixed 3 40+        u4B <- parseWord64BE+        parsePad (0xD0 - 4)+        u4A <- parseWord64BE++        parseFixed 3 30+        u3 <- parseWord64BE++        parseFixed 3 20+        u2 <- parseWord64BE++        parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 10+        u1 <- parseWord64BE++        pure (u7, (u6B, u6A), (u5B, u5A), (u4B, u4A), u3, u2, u1)++  let actual, expected ::+        Maybe ( ( Word64, (Word64, Word64), (Word64, Word64)+                , (Word64, Word64), Word64, Word64, Word64 )+              , [(Int, Word8)]+              )+      actual = second rle <$> runStateT parseAll encodedBytes+      expected = Just ((u7, (u6B,u6A), (u5B,u5A), (u4B, u4A), u3, u2, u1), [])+        where+          u1 = fromIntegral $ buildRSmallChunkSize  -- before we wrote anything+          u2 = fromIntegral $ buildRSmallChunkSize  -- bypassed unused buffer+          u3 = fromIntegral $ buildRSmallChunkSize - 11   -- after second write+          u4A = fromIntegral $ buildRSmallChunkSize - 22  -- after third write+          u4B = 11   -- after padding+          u5A = 0    -- buffer full from previous write+          u5B = 10   -- after padding+          u6A = fromIntegral $ buildRDefaultChunkSize+                     -- new buffer after bypassing used buffer+          u6B = 0    -- buffer completely full+          u7 = fromIntegral $ buildRDefaultChunkSize+                     -- new buffer after bypassing used buffer++  let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)+  HU.assertEqual msg expected actual++lazyByteString :: TestTree+lazyByteString = HU.testCase "Strict ByteString BuildR" $ do+  -- Because the initial buffer has a distinctive size we can use+  -- to distinguish it from other buffers, we start with a string+  -- whose chunks do not fit in that buffer, so that we can check that+  -- the buffer is reused as-is after those strings, not reallocated.+  let builder1 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+        BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 12 ) <>+        BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 11 ) <>+        BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1) 10 <>+                        encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder1 #-}++  -- Then we write a string whose rightmost two chunks do fit+  -- within the initial buffer but whose leftmost chunk does+  -- not fit after the others are written.  We ensure that most+  -- of the initial buffer is consumed because otherwise it might+  -- be recycled, which would prevent us from detecting that some+  -- chunks were actually written to the buffer.+  let builder2 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+        BL.fromStrict ( B.replicate 3 22 ) <>+        BL.fromStrict ( B.replicate (buildRSmallChunkSize + 1 - 14) 21 ) <>+        BL.fromStrict ( B.replicate 3 20 <> encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder2 #-}++  -- And a string that fits entirely within the second buffer.+  let builder3 = Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+        BL.fromStrict ( B.replicate 3 32 ) <>+        BL.fromStrict ( B.replicate 3 31 ) <>+        BL.fromStrict ( B.replicate 3 30 <> encodeWord64BE (fromIntegral u) )+      {-# NOINLINE builder3 #-}++  -- Then we check the just-enough-room case.+  let builder4 =+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (B.replicate 3 41) <>+            BL.fromStrict (B.replicate 3 40 <> encodeWord64BE (fromIntegral u))+        ) <> fillUnusedExcept 14 (0xD0 - 4) <>+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (encodeWord64BE (fromIntegral u))+        )+      {-# NOINLINE builder4 #-}++  -- Then the case of the almost-full-buffer with not quite enough room.+  let builder5 =+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (B.replicate 3 51) <>+            BL.fromStrict (B.replicate 3 50 <> encodeWord64BE (fromIntegral u))+        ) <> fillUnusedExcept 13 (0xD0 - 5) <>+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (encodeWord64BE (fromIntegral u))+        )+      {-# NOINLINE builder5 #-}++  -- Then the full-buffer case.+  let builder6 =+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (B.replicate 3 61) <>+            BL.fromStrict (B.replicate 3 60 <> encodeWord64BE (fromIntegral u))+        ) <> fillUnused (0xD0 - 6) <>+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (encodeWord64BE (fromIntegral u))+        )+      {-# NOINLINE builder6 #-}++  -- Check final unused.+  let builder7 =+        ( Reverse.testWithUnused $ \u -> Reverse.lazyByteString $+            BL.fromStrict (B.replicate 3 70 <> encodeWord64BE (fromIntegral u))+        )+      {-# NOINLINE builder7 #-}++  let buildAll = builder7 <> builder6 <> builder5 <>+                 builder4 <> builder3 <> builder2 <> builder1++  let encodedBytes :: BL.ByteString+      encodedBytes = Reverse.toLazyByteString buildAll++  let parseFixed :: Int64 -> Word8 -> StateT BL.ByteString Maybe ()+      parseFixed n w = do+        bl <- parseBytes n+        guard (BL.all (w ==) bl)++  let parsePad :: Word8 -> StateT BL.ByteString Maybe ()+      parsePad = void . parseWhile . (==)++  let parseAll :: StateT BL.ByteString Maybe+                         ( Word64, (Word64, Word64), (Word64, Word64),+                           (Word64, Word64), Word64, Word64, Word64 )+      parseAll = do+        parseFixed 3 70+        u7 <- parseWord64BE++        parseFixed 3 61+        parseFixed 3 60+        u6B <- parseWord64BE+        parsePad (0xD0 - 6)+        u6A <- parseWord64BE++        parseFixed 3 51+        parseFixed 3 50+        u5B <- parseWord64BE+        parsePad (0xD0 - 5)+        u5A <- parseWord64BE++        parseFixed 3 41+        parseFixed 3 40+        u4B <- parseWord64BE+        parsePad (0xD0 - 4)+        u4A <- parseWord64BE++        parseFixed 3 32+        parseFixed 3 31+        parseFixed 3 30+        u3 <- parseWord64BE++        parseFixed 3 22+        parseFixed (fromIntegral (buildRSmallChunkSize + 1 - 14)) 21+        parseFixed 3 20+        u2 <- parseWord64BE++        parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 12+        parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 11+        parseFixed (fromIntegral (buildRSmallChunkSize + 1)) 10+        u1 <- parseWord64BE++        pure (u7, (u6B, u6A), (u5B, u5A), (u4B, u4A), u3, u2, u1)++  let actual, expected ::+        Maybe ( ( Word64, (Word64, Word64), (Word64, Word64)+                , (Word64, Word64), Word64, Word64, Word64 )+              , [(Int, Word8)]+              )+      actual = second rle <$> runStateT parseAll encodedBytes+      expected = Just ((u7, (u6B,u6A), (u5B,u5A), (u4B, u4A), u3, u2, u1), [])+        where+          u1 = fromIntegral $ buildRSmallChunkSize  -- before we wrote anything+          u2 = fromIntegral $ buildRSmallChunkSize  -- bypassed unused buffer+          u3 = fromIntegral $ buildRDefaultChunkSize -- after second write+          u4A = fromIntegral $ buildRDefaultChunkSize - 17 -- after third write+          u4B = 14   -- after padding+          u5A = 0    -- buffer full from previous write+          u5B = 13   -- after padding+          u6A = fromIntegral $ buildRDefaultChunkSize+                     -- new buffer after bypassing used buffer+          u6B = 0    -- buffer completely full+          u7 = fromIntegral $ buildRDefaultChunkSize+                     -- new buffer after bypassing used buffer++  let msg = "run-length encoding of built bytes: " ++ show (rle encodedBytes)+  HU.assertEqual msg expected actual+ decodeNonsense :: TestTree decodeNonsense = HU.testCase "Decoding a nonsensical string fails." $ do   let decoded = Decode.parse (one Decode.fixed64 0 `at` fieldNumber 1) "test"   HU.assertBool "decode fails" $ isLeft decoded++packedLargeTests :: TestTree+packedLargeTests = testGroup "Test packed encoders on large inputs"+  [ packedVarints_large+  , packedVarintsV_large+  , packedBoolsV_large+  , packedFixed32_large+  , packedFixed32V_large+  , packedFixed64_large+  , packedFixed64V_large+  , packedFloats_large+  , packedFloatsV_large+  , packedDoubles_large+  , packedDoublesV_large+  ]++packedVarints_large :: TestTree+packedVarints_large = HU.testCase "Large packedVarints" $ do+  let count = 40000+      encoded = Encode.toLazyByteString (Encode.packedVarints 13 [1 .. count])+      decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [1 .. count]) decoded++packedVarintsV_large :: TestTree+packedVarintsV_large = HU.testCase "Large packedVarintsV" $ do+  let count = 40000+      encoded = Encode.toLazyByteString+                  (Encode.packedVarintsV (1 +) 13 (V.fromList [1 .. count]))+      decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded++packedBoolsV_large :: TestTree+packedBoolsV_large = HU.testCase "Large packedBoolsV" $ do+  let count = 40000 :: Int+      values = map (flip Bits.testBit 0) [1 .. count]+      encoded = Encode.toLazyByteString+                  (Encode.packedBoolsV not 13 (V.fromList values))+      decoded = Decode.parse (one Decode.packedVarints [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right (map (fromEnum . not) values)) decoded++packedFixed32_large :: TestTree+packedFixed32_large = HU.testCase "Large packedFixed32" $ do+  let count = 40000+      encoded = Encode.toLazyByteString (Encode.packedFixed32 13 [1 .. count])+      decoded = Decode.parse (one Decode.packedFixed32 [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [1 .. count]) decoded++packedFixed32V_large :: TestTree+packedFixed32V_large = HU.testCase "Large packedFixed32V" $ do+  let count = 40000+      encoded = Encode.toLazyByteString+                  (Encode.packedFixed32V (1 +) 13 (V.fromList [1 .. count]))+      decoded = Decode.parse (one Decode.packedFixed32 [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded++packedFixed64_large :: TestTree+packedFixed64_large = HU.testCase "Large packedFixed64" $ do+  let count = 40000+      encoded = Encode.toLazyByteString (Encode.packedFixed64 13 [1 .. count])+      decoded = Decode.parse (one Decode.packedFixed64 [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [1 .. count]) decoded++packedFixed64V_large :: TestTree+packedFixed64V_large = HU.testCase "Large packedFixed64V" $ do+  let count = 40000+      encoded = Encode.toLazyByteString+                  (Encode.packedFixed64V (1 +) 13 (V.fromList [1 .. count]))+      decoded = Decode.parse (one Decode.packedFixed64 [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded++packedFloats_large :: TestTree+packedFloats_large = HU.testCase "Large packedFloats" $ do+  let count = 40000+      encoded = Encode.toLazyByteString (Encode.packedFloats 13 [1 .. count])+      decoded = Decode.parse (one Decode.packedFloats [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [1 .. count]) decoded++packedFloatsV_large :: TestTree+packedFloatsV_large = HU.testCase "Large packedFloatsV" $ do+  let count = 40000+      encoded = Encode.toLazyByteString+                  (Encode.packedFloatsV (1 +) 13 (V.fromList [1 .. count]))+      decoded = Decode.parse (one Decode.packedFloats [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded++packedDoubles_large :: TestTree+packedDoubles_large = HU.testCase "Large packedDoubles" $ do+  let count = 40000+      encoded = Encode.toLazyByteString (Encode.packedDoubles 13 [1 .. count])+      decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [1 .. count]) decoded++packedDoublesV_large :: TestTree+packedDoublesV_large = HU.testCase "Large packedDoublesV" $ do+  let count = 40000+      encoded = Encode.toLazyByteString+                  (Encode.packedDoublesV (1 +) 13 (V.fromList [1 .. count]))+      decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)+                             (BL.toStrict encoded)+  HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded