proto3-wire 1.4.4 → 1.4.5

raw patch · 9 files changed

+765/−73 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• bench/Main.hs +4/−5
• proto3-wire.cabal +6/−3
• src/Proto3/Wire/Encode.hs +293/−54
• src/Proto3/Wire/Encode/Repeated.hs +185/−0
• src/Proto3/Wire/FoldR.hs +80/−0
• src/Proto3/Wire/Reverse.hs +73/−9
• src/Proto3/Wire/Reverse/Prim.hs +28/−0
• test/Main.hs +89/−2

@@ -1,3 +1,10 @@+1.4.5+  - Add encoders for packed repeated fields that can iterate in+    reverse order for speed when practical and will predict size+    when it is inexpensive to do so.+  - Add bytesIfNonempty, etaMessageBuilder, unsafeFromByteString,+    unsafeFromShortByteString, repeatedMessageBuilder.+ 1.4.4   - Support GHC 9.10 

@@ -15,7 +15,6 @@  import Control.Applicative (liftA2, liftA3) import Control.Monad (forM)-import Data.Maybe import Data.Word import Data.IORef @@ -39,7 +38,7 @@     in a + a1 + a2  instance Foldable Rose where-  foldMap f Bud = mempty+  foldMap _ Bud = mempty   foldMap f (Rose x rs) = f x <> ((foldMap.foldMap) f rs)  intTreeParser :: De.Parser De.RawMessage (Tree Word64)@@ -123,9 +122,9 @@ pullInt xs = do   xs' <- readIORef xs   case xs' of-    [] -> pure (-1)-    x : xs' -> do-      writeIORef xs xs'+    [] -> pure (negate 1)+    x : xs'' -> do+      writeIORef xs xs''       pure x  mkTree0 :: IO Word64 -> IO En.MessageBuilder

@@ -1,7 +1,7 @@ cabal-version: >=1.10  name:         proto3-wire-version:      1.4.4+version:      1.4.5 synopsis:     A low-level implementation of the Protocol Buffers (version 3) wire format license:      Apache-2.0 license-file: LICENSE@@ -37,7 +37,7 @@       base >=4.12 && <=5.0     , bytestring >=0.10.6.0 && <0.13.0     , cereal >= 0.5.1 && <0.6-    , containers >=0.5 && < 0.8+    , containers >=0.5 && <0.8     , deepseq >=1.4 && <1.6     , hashable <1.6     , parameterized >=0.5.0.0 && <1@@ -58,11 +58,13 @@     Proto3.Wire.Class     Proto3.Wire.Decode     Proto3.Wire.Encode+    Proto3.Wire.Encode.Repeated+    Proto3.Wire.FoldR     Proto3.Wire.Reverse+    Proto3.Wire.Reverse.Internal     Proto3.Wire.Reverse.Prim     Proto3.Wire.Tutorial     Proto3.Wire.Types-    Proto3.Wire.Reverse.Internal    other-modules:     Proto3.Wire.Reverse.Width@@ -77,6 +79,7 @@       base >=4.9 && <=5.0     , bytestring >=0.10.6.0 && <0.13.0     , cereal >= 0.5.1 && <0.6+    , containers >=0.5 && <0.8     , doctest >= 0.7.0 && <0.24.0     , proto3-wire     , QuickCheck >=2.8 && <3.0

@@ -40,6 +40,9 @@  {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -54,10 +57,13 @@     ( -- * `MessageBuilder` type       MessageBuilder     , reverseMessageBuilder+    , etaMessageBuilder     , vectorMessageBuilder     , messageLength     , toLazyByteString     , unsafeFromLazyByteString+    , unsafeFromByteString+    , unsafeFromShortByteString        -- * Standard Integers     , int32@@ -79,6 +85,7 @@     , bool       -- * Strings     , bytes+    , bytesIfNonempty     , string     , text     , shortText@@ -87,17 +94,32 @@     , shortByteString       -- * Embedded Messages     , embedded+      -- * Folds+    , repeatedMessageBuilder       -- * Packed repeated fields     , packedVarints     , packedVarintsV+    , packedInt32R+    , packedInt64R+    , packedUInt32R+    , packedUInt64R+    , packedSInt32R+    , packedSInt64R+    , packedBoolsR     , packedBoolsV     , packedFixed32+    , packedFixed32R     , packedFixed32V     , packedFixed64+    , packedFixed64R     , packedFixed64V+    , packedSFixed32R+    , packedSFixed64R     , packedFloats+    , packedFloatsR     , packedFloatsV     , packedDoubles+    , packedDoublesR     , packedDoublesV       -- * ZigZag codec     , zigZagEncode@@ -118,13 +140,14 @@ import           Parameterized.Data.Semigroup  ( PNullary, PSemigroup(..),                                                  (&<>) ) import           Parameterized.Data.Monoid     ( PMEmpty(..) )+import           Proto3.Wire.Encode.Repeated   ( ToRepeated, mapRepeated ) 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 -XOverloadedLists+-- >>> :set -XOverloadedStrings -XOverloadedLists -XTypeApplications -- >>> :module Proto3.Wire.Encode Proto3.Wire.Class Data.Word  -- | zigzag-encoded numeric type.@@ -142,7 +165,7 @@ -- -- Use `toLazyByteString` when you're done assembling the `MessageBuilder` newtype MessageBuilder = MessageBuilder { unMessageBuilder :: RB.BuildR }-  deriving (Monoid, Semigroup)+  deriving newtype (Monoid, Semigroup)  instance Show MessageBuilder where   showsPrec prec builder =@@ -176,15 +199,22 @@ toLazyByteString :: MessageBuilder -> BL.ByteString toLazyByteString = RB.toLazyByteString . unMessageBuilder --- | This lets you cast an arbitrary `ByteString` to a `MessageBuilder`, whether+-- | This lets you cast an arbitrary 'BL.ByteString' to a `MessageBuilder`, whether -- or not the `ByteString` corresponds to a valid serialized protobuf message -- -- Do not use this function unless you know what you're doing because it lets--- you assemble malformed protobuf `MessageBuilder`s+-- you assemble malformed protobuf `MessageBuilder`s. unsafeFromLazyByteString :: BL.ByteString -> MessageBuilder-unsafeFromLazyByteString bytes' =-    MessageBuilder { unMessageBuilder = RB.lazyByteString bytes' }+unsafeFromLazyByteString = coerce RB.lazyByteString +-- | Like 'unsafeFromLazyByteString' only for strict 'B.ByteString's.+unsafeFromByteString :: B.ByteString -> MessageBuilder+unsafeFromByteString = coerce RB.byteString++-- | Like 'unsafeFromLazyByteString' only for 'BS.ShortByteString's.+unsafeFromShortByteString :: BS.ShortByteString -> MessageBuilder+unsafeFromShortByteString = coerce RB.shortByteString+ newtype MessageBoundedPrim w   = MessageBoundedPrim { unMessageBoundedPrim :: Prim.BoundedPrim w } @@ -276,7 +306,7 @@ -- 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 -> liftBoundedPrim $+int32 = \(!num) i -> liftBoundedPrim $     fieldHeader num Varint &<> base128Varint64 (fromIntegral i) {-# INLINE int32 #-} @@ -289,7 +319,7 @@ -- >>> 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 -> liftBoundedPrim $+int64 = \(!num) i -> liftBoundedPrim $     fieldHeader num Varint &<> base128Varint64 (fromIntegral i) {-# INLINE int64 #-} @@ -300,7 +330,7 @@ -- >>> 1 `uint32` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*" uint32 :: FieldNumber -> Word32 -> MessageBuilder-uint32 = \num i -> liftBoundedPrim $+uint32 = \(!num) i -> liftBoundedPrim $     fieldHeader num Varint &<> base128Varint32 i {-# INLINE uint32 #-} @@ -311,7 +341,7 @@ -- >>> 1 `uint64` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*" uint64 :: FieldNumber -> Word64 -> MessageBuilder-uint64 = \num i -> liftBoundedPrim $+uint64 = \(!num) i -> liftBoundedPrim $     fieldHeader num Varint &<> base128Varint64 i {-# INLINE uint64 #-} @@ -326,7 +356,7 @@ -- >>> 1 `sint32` minBound -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\255\255\255\255\SI" sint32 :: FieldNumber -> Int32 -> MessageBuilder-sint32 = \num i ->+sint32 = \(!num) i ->   uint32 num (fromIntegral (zigZagEncode i)) {-# INLINE sint32 #-} @@ -341,7 +371,7 @@ -- >>> 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 ->+sint64 = \(!num) i ->   uint64 num (fromIntegral (zigZagEncode i)) {-# INLINE sint64 #-} @@ -352,7 +382,7 @@ -- >>> 1 `fixed32` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\r*\NUL\NUL\NUL" fixed32 :: FieldNumber -> Word32 -> MessageBuilder-fixed32 = \num i -> liftBoundedPrim $+fixed32 = \(!num) i -> liftBoundedPrim $     fieldHeader num Fixed32 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.word32LE i)) {-# INLINE fixed32 #-}@@ -364,7 +394,7 @@ -- >>> 1 `fixed64` 42 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t*\NUL\NUL\NUL\NUL\NUL\NUL\NUL" fixed64 :: FieldNumber -> Word64 -> MessageBuilder-fixed64 = \num i -> liftBoundedPrim $+fixed64 = \(!num) i -> liftBoundedPrim $     fieldHeader num Fixed64 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.word64LE i)) {-# INLINE fixed64 #-}@@ -375,7 +405,7 @@ -- -- > 1 `sfixed32` (-42) sfixed32 :: FieldNumber -> Int32 -> MessageBuilder-sfixed32 = \num i -> liftBoundedPrim $+sfixed32 = \(!num) i -> liftBoundedPrim $     fieldHeader num Fixed32 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.int32LE i)) {-# INLINE sfixed32 #-}@@ -387,7 +417,7 @@ -- >>> 1 `sfixed64` (-42) -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\214\255\255\255\255\255\255\255" sfixed64 :: FieldNumber -> Int64 -> MessageBuilder-sfixed64 = \num i -> liftBoundedPrim $+sfixed64 = \(!num) i -> liftBoundedPrim $     fieldHeader num Fixed64 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.int64LE i)) {-# INLINE sfixed64 #-}@@ -399,7 +429,7 @@ -- >>> 1 `float` 3.14 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\r\195\245H@" float :: FieldNumber -> Float -> MessageBuilder-float = \num f -> liftBoundedPrim $+float = \(!num) f -> liftBoundedPrim $     fieldHeader num Fixed32 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.floatLE f)) {-# INLINE float #-}@@ -411,7 +441,7 @@ -- >>> 1 `double` 3.14 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\US\133\235Q\184\RS\t@" double :: FieldNumber -> Double -> MessageBuilder-double = \num d -> liftBoundedPrim $+double = \(!num) d -> liftBoundedPrim $     fieldHeader num Fixed64 &<>     MessageBoundedPrim (Prim.liftFixedPrim (Prim.doubleLE d)) {-# INLINE double #-}@@ -440,7 +470,7 @@ -- >>> 1 `enum` Triangle <> 2 `enum` Gap3 -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\STX\DLE\ETX" enum :: ProtoEnum e => FieldNumber -> e -> MessageBuilder-enum = \num e -> liftBoundedPrim $+enum = \(!num) e -> liftBoundedPrim $     fieldHeader num Varint &<>     base128Varint32 (fromIntegral @Int32 @Word32 (fromProtoEnum e)) {-# INLINE enum #-}@@ -452,7 +482,7 @@ -- >>> 1 `bool` True -- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\SOH" bool :: FieldNumber -> Bool -> MessageBuilder-bool = \num b -> liftBoundedPrim $+bool = \(!num) b -> liftBoundedPrim $     fieldHeader num Varint &<>     MessageBoundedPrim       (Prim.liftFixedPrim (Prim.word8 (fromIntegral (fromEnum b))))@@ -461,12 +491,39 @@  -- | Encode a sequence of octets as a field of type 'bytes'. --+-- But unless the field is @optional@ or part of a @oneof@,+-- you may wish to to use 'bytesIfNonempty' to skip the field+-- when the payload built by the argument turns out to be empty.+--+-- >>> 1 `bytes` (Proto3.Wire.Reverse.stringUtf8 "")+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NUL" -- >>> 1 `bytes` (Proto3.Wire.Reverse.stringUtf8 "testing") -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" bytes :: FieldNumber -> RB.BuildR -> MessageBuilder-bytes num = embedded num . MessageBuilder+bytes !num = embedded num . MessageBuilder {-# INLINE bytes #-} +-- | Like 'bytes' but omits the field if it would be empty, which+-- is useful when the field is not @optional@ and is not part of+-- a @oneof@, and therefore may be omitted entirely when empty.+--+-- >>> 1 `bytesIfNonempty` (Proto3.Wire.Reverse.stringUtf8 "")+-- Proto3.Wire.Encode.unsafeFromLazyByteString ""+-- >>> 1 `bytesIfNonempty` (Proto3.Wire.Reverse.stringUtf8 "testing")+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"+bytesIfNonempty :: FieldNumber -> RB.BuildR -> MessageBuilder+bytesIfNonempty !num bb =+    MessageBuilder (RB.withLengthOf prefix bb)+  where+    prefix len+      | 0 < len = Prim.liftBoundedPrim $+          unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>+          Prim.wordBase128LEVar (fromIntegral @Int @Word len)+      | otherwise =+          mempty+    {-# INLINE prefix #-}+{-# INLINE bytesIfNonempty #-}+ -- | Encode a UTF-8 string. -- -- For example:@@ -474,7 +531,7 @@ -- >>> 1 `string` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" string :: FieldNumber -> String -> MessageBuilder-string num = embedded num . MessageBuilder . RB.stringUtf8+string !num = embedded num . MessageBuilder . RB.stringUtf8 {-# INLINE string #-}  -- | Encode lazy `Text` as UTF-8@@ -484,7 +541,7 @@ -- >>> 1 `text` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" text :: FieldNumber -> Text.Lazy.Text -> MessageBuilder-text num = embedded num . MessageBuilder . RB.lazyTextUtf8+text !num = embedded num . MessageBuilder . RB.lazyTextUtf8 {-# INLINE text #-}  -- | Encode a `Text.Short.ShortText` as UTF-8.@@ -494,7 +551,7 @@ -- >>> 1 `shortText` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" shortText :: FieldNumber -> Text.Short.ShortText -> MessageBuilder-shortText num = embedded num . MessageBuilder . RB.shortTextUtf8+shortText !num = embedded num . MessageBuilder . RB.shortTextUtf8 {-# INLINE shortText #-}  -- | Encode a collection of bytes in the form of a strict 'B.ByteString'.@@ -504,7 +561,7 @@ -- >>> 1 `byteString` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" byteString :: FieldNumber -> B.ByteString -> MessageBuilder-byteString num = embedded num . MessageBuilder . RB.byteString+byteString !num = embedded num . unsafeFromByteString {-# INLINE byteString #-}  -- | Encode a lazy bytestring.@@ -514,7 +571,7 @@ -- >>> 1 `lazyByteString` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" lazyByteString :: FieldNumber -> BL.ByteString -> MessageBuilder-lazyByteString num = embedded num . MessageBuilder . RB.lazyByteString+lazyByteString !num = embedded num . unsafeFromLazyByteString {-# INLINE lazyByteString #-}  -- | Encode a `BS.ShortByteString`.@@ -524,22 +581,60 @@ -- >>> 1 `shortByteString` "testing" -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting" shortByteString :: FieldNumber -> BS.ShortByteString -> MessageBuilder-shortByteString num = embedded num . MessageBuilder . RB.shortByteString+shortByteString !num = embedded num . unsafeFromShortByteString {-# INLINE shortByteString #-} --- | Encode varints in the space-efficient packed format.--- But consider 'packedVarintsV', which may be faster.+-- | Concatenates the given builders, which typically build fields within the same message. ----- The values to be encoded are specified by mapping the elements of a vector.+-- For example: --+-- >>> repeatedMessageBuilder @[MessageBuilder] [1 `bool` True, 2 `int32` 42]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\SOH\DLE*"+repeatedMessageBuilder :: ToRepeated c MessageBuilder => c -> MessageBuilder+repeatedMessageBuilder =+  etaMessageBuilder (MessageBuilder . RB.repeatedBuildR . mapRepeated reverseMessageBuilder)+{-# INLINE repeatedMessageBuilder #-}++-- | Encodes a packed repeated field whose elements may vary in width.+packedVariableWidthFieldR ::+  ToRepeated c a => (a -> RB.BuildR) -> FieldNumber -> c -> MessageBuilder+packedVariableWidthFieldR f !num =+  etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedBuildR . mapRepeated f)+{-# INLINE packedVariableWidthFieldR #-}++-- | Encodes a packed repeated field whose elements never vary in width.+packedFixedWidthFieldR ::+  (ToRepeated c a, KnownNat w) => (a -> Prim.FixedPrim w) -> FieldNumber -> c -> MessageBuilder+packedFixedWidthFieldR f !num =+  etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedFixedPrimR . mapRepeated f)+{-# INLINE packedFixedWidthFieldR #-}++-- | Encode varints in the space-efficient packed format.+-- But consider 'packedVarintsV' or 'packedVarintsR', either of which may be faster.+-- -- >>> packedVarints 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX" packedVarints :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder-packedVarints num = etaMessageBuilder (embedded num . payload)+packedVarints !num = etaMessageBuilder (embedded num . payload)   where     payload = foldMap (liftBoundedPrim . base128Varint64) {-# INLINE packedVarints #-} +-- | A faster but more specialized variant of 'packedVarints'.+--+-- Generalizes 'packedVarintsV', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+packedVarints64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder+packedVarints64R = packedVariableWidthFieldR RB.word64Base128LEVar+{-# INLINE packedVarints64R #-}++-- | Like 'packedVarints64R' but supports only 32-bit inputs,+-- which reduces on executable size in situations where we do+-- not need to support larger values.+packedVarints32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder+packedVarints32R = packedVariableWidthFieldR RB.word32Base128LEVar+{-# INLINE packedVarints32R #-}+ -- | A faster but more specialized variant of: -- -- > \f num -> packedVarints num . fmap f@@ -548,37 +643,128 @@ -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX" packedVarintsV ::   Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder-packedVarintsV f num = embedded num . payload+packedVarintsV f !num = embedded num . payload   where     payload = vectorMessageBuilder (liftBoundedPrim . base128Varint64 . f) {-# INLINE packedVarintsV #-} +-- | Encodes a packed repeated @int32@ field.+--+-- >>> packedInt32R @[_] 1 [42, -42]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\v*\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>+packedInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder+packedInt32R !num xs =+  packedVarints64R num (mapRepeated (fromIntegral @Int32 @Word64) xs)+{-# INLINE packedInt32R #-}++-- | Encodes a packed repeated @int64@ field.+--+-- For example:+--+-- >>> packedInt64R @[_] 1 [42, -42]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\v*\214\255\255\255\255\255\255\255\255\SOH"+packedInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder+packedInt64R !num xs =+  packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64) xs)+{-# INLINE packedInt64R #-}++-- | Encodes a packed repeated @uint32@ field.+--+-- For example:+--+-- >>> packedUInt32R @[_] 1 [42, 43, maxBound]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\a*+\255\255\255\255\SI"+packedUInt32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder+packedUInt32R = packedVarints32R+{-# INLINE packedUInt32R #-}++-- | Encodes a packed repeated @uint64@ field.+--+-- For example:+--+-- >>> packedUInt64R @[_] 1 [42, 43, maxBound]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f*+\255\255\255\255\255\255\255\255\255\SOH"+packedUInt64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder+packedUInt64R = packedVarints64R+{-# INLINE packedUInt64R #-}++-- | Encodes a packed repeated @sint32@ field.+--+-- For example:+--+-- >>> packedSInt32R @[_] 1 [-42, maxBound, minBound]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\vS\254\255\255\255\SI\255\255\255\255\SI"+packedSInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder+packedSInt32R !num xs =+  packedVarints32R num (mapRepeated (fromIntegral @Int32 @Word32 . zigZagEncode) xs)+{-# INLINE packedSInt32R #-}++-- | Encodes a packed repeated @sint64@ field.+--+-- For example:+--+-- >>> packedSInt64R @[_] 1 [-42, maxBound, minBound]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NAKS\254\255\255\255\255\255\255\255\255\SOH\255\255\255\255\255\255\255\255\255\SOH"+packedSInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder+packedSInt64R !num xs =+  packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64 . zigZagEncode) xs)+{-# INLINE packedSInt64R #-}+ -- | A faster but more specialized variant of: ----- > packedVarintsV (fromIntegral . fromEnum) num+-- > \f -> packedVarintsR (fromIntegral . fromEnum . f) --+-- Generalizes 'packedBoolsV', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- >>> packedBoolsR @[_] 1 [True, False]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"+packedBoolsR :: ToRepeated c Bool => FieldNumber -> c -> MessageBuilder+packedBoolsR = packedFixedWidthFieldR (Prim.word8 . fromIntegral . fromEnum)+{-# INLINE packedBoolsR #-}++-- | A faster but more specialized variant of:+--+-- > \f -> packedVarintsV (fromIntegral . fromEnum . f)+-- -- >>> 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 . payload+packedBoolsV f !num = embedded num . MessageBuilder . payload   where     payload = Prim.vectorFixedPrim (Prim.word8 . fromIntegral . fromEnum . f) {-# INLINE packedBoolsV #-}  -- | Encode fixed-width Word32s in the space-efficient packed format.--- But consider 'packedFixed32V', which may be faster.------ The values to be encoded are specified by mapping the elements of a vector.+-- But consider 'packedFixed32V' or 'packedFixed32R', either of which may be faster. -- -- >>> 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 = etaMessageBuilder (embedded num . payload)+packedFixed32 !num = etaMessageBuilder (embedded num . payload)   where     payload = foldMap (MessageBuilder . RB.word32LE) {-# INLINE packedFixed32 #-} +-- | A faster but more specialized variant of 'packedFixed32'.+--+-- Generalizes 'packedFixed32V', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- >>> packedFixed32R @[_] 1 [1, 2, 3]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"+packedFixed32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder+packedFixed32R = packedFixedWidthFieldR Prim.word32LE+{-# INLINE packedFixed32R #-}+ -- | A faster but more specialized variant of: -- -- > \f num -> packedFixed32 num . fmap f@@ -587,24 +773,32 @@ -- 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 = etaMessageBuilder (embedded num . payload)+packedFixed32V f !num = etaMessageBuilder (embedded num . payload)   where     payload = 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.------ The values to be encoded are specified by mapping the elements of a vector.+-- But consider 'packedFixed64V' or 'packedFixed64R', either of which may be faster. -- -- >>> 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 = etaMessageBuilder (embedded num . payload)+packedFixed64 !num = etaMessageBuilder (embedded num . payload)   where     payload = foldMap (MessageBuilder . RB.word64LE) {-# INLINE packedFixed64 #-} +-- | A faster but more specialized variant of 'packedFixed64'.+--+-- Generalizes 'packedFixed64V', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- >>> packedFixed64R @[_] 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"+packedFixed64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder+packedFixed64R = packedFixedWidthFieldR Prim.word64LE+{-# INLINE packedFixed64R #-}+ -- | A faster but more specialized variant of: -- -- > \f num -> packedFixed64 num . fmap f@@ -613,22 +807,53 @@ -- 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 = etaMessageBuilder (embedded num . payload)+packedFixed64V f !num = etaMessageBuilder (embedded num . payload)   where     payload = MessageBuilder . Prim.vectorFixedPrim (Prim.word64LE . f) {-# INLINE packedFixed64V #-} +-- | Encodes a packed repeated @sfixed32@ field.+--+-- For example:+--+-- >>> packedSFixed32R @[_] 1 [1, -2, 3]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\254\255\255\255\ETX\NUL\NUL\NUL"+packedSFixed32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder+packedSFixed32R = packedFixedWidthFieldR Prim.int32LE+{-# INLINE packedSFixed32R #-}++-- | Encodes a packed repeated @sfixed64@ field.+--+-- For example:+--+-- >>> packedSFixed64R @[_] 1 [1, -2, 3]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\254\255\255\255\255\255\255\255\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"+packedSFixed64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder+packedSFixed64R = packedFixedWidthFieldR Prim.int64LE+{-# INLINE packedSFixed64R #-}+ -- | Encode floats in the space-efficient packed format.--- But consider 'packedFloatsV', which may be faster.+-- But consider 'packedFloatsV' or 'packedFloatsR', either of 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 = etaMessageBuilder (embedded num . payload)+packedFloats !num = etaMessageBuilder (embedded num . payload)   where     payload = foldMap (MessageBuilder . RB.floatLE) {-# INLINE packedFloats #-} +-- | A faster but more specialized variant of 'packedFloats'.+--+-- Generalizes 'packedFloatsV', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- >>> packedFloatsR @[_] 1 [1, 2, 3]+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"+packedFloatsR :: ToRepeated c Float => FieldNumber -> c -> MessageBuilder+packedFloatsR = packedFixedWidthFieldR Prim.floatLE+{-# INLINE packedFloatsR #-}+ -- | A faster but more specialized variant of: -- -- > \f num -> packedFloats num . fmap f@@ -637,22 +862,33 @@ -- 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 = etaMessageBuilder (embedded num . payload)+packedFloatsV f !num = etaMessageBuilder (embedded num . payload)   where     payload = MessageBuilder . Prim.vectorFixedPrim (Prim.floatLE . f) {-# INLINE packedFloatsV #-}  -- | Encode doubles in the space-efficient packed format.--- But consider 'packedDoublesV', which may be faster.+-- But consider 'packedDoublesV' or 'packedDoublesR', either of 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 = etaMessageBuilder (embedded num . payload)+packedDoubles !num = etaMessageBuilder (embedded num . payload)   where     payload = foldMap (MessageBuilder . RB.doubleLE) {-# INLINE packedDoubles #-} +-- | A faster but more specialized variant of 'packedDoubles'.+--+-- Generalizes 'packedDoublesV', provided that any new instance+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- >>> packedDoublesR @[_] 1 [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@"+packedDoublesR :: ToRepeated c Double => FieldNumber -> c -> MessageBuilder+packedDoublesR = packedFixedWidthFieldR Prim.doubleLE+{-# INLINE packedDoublesR #-}+ -- | A faster but more specialized variant of: -- -- > \f num -> packedDoubles num . fmap f@@ -661,7 +897,7 @@ -- 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 = etaMessageBuilder (embedded num . payload)+packedDoublesV f !num = etaMessageBuilder (embedded num . payload)   where     payload = MessageBuilder . Prim.vectorFixedPrim (Prim.doubleLE . f) {-# INLINE packedDoublesV #-}@@ -673,13 +909,16 @@ -- -- For example: --+-- >>> 1 `embedded` mempty+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NUL" -- >>> 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 (MessageBuilder bb) ->-    MessageBuilder (RB.withLengthOf (Prim.liftBoundedPrim . prefix num) bb)+embedded = \(!num) (MessageBuilder bb) ->+    MessageBuilder (RB.withLengthOf (prefix num) bb)   where-    prefix num len =+    prefix !num len = Prim.liftBoundedPrim $       unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>       Prim.wordBase128LEVar (fromIntegral @Int @Word len)+    {-# INLINE prefix #-} {-# INLINE embedded #-}

@@ -0,0 +1,185 @@+{-+  Copyright 2025 Arista 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 DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneKindSignatures #-}++-- | Presents right-associative folds as 'Foldable' sequences.+module Proto3.Wire.Encode.Repeated+  ( Repeated(..)+  , nullRepeated+  , ToRepeated(..)+  , mapRepeated+  ) where++import Data.Functor.Identity (Identity(..))+import Data.IntMap.Lazy qualified+import Data.IntSet qualified+import Data.Kind (Type)+import Data.List.NonEmpty qualified+import Data.Map.Lazy qualified+import Data.Sequence qualified+import Data.Set qualified+import Data.Vector qualified+import Data.Vector.Storable qualified+import Data.Vector.Unboxed qualified+import Foreign (Storable)+import GHC.Exts (Constraint, TYPE)+import GHC.Generics (Generic)+import Proto3.Wire.FoldR (FoldR(..), fromFoldR)++-- | Expresses a sequence of values /in reverse order/ for encoding as a repeated field.+type Repeated :: forall er . TYPE er -> Type+data Repeated e = ReverseRepeated+  { countRepeated :: Maybe Int+      -- ^ Optionally predicts the number of elements in the sequence.  Predict+      -- the count only when it is practical to do so accurately and quickly.+      --+      -- A prediction that is too low causes undefined behavior--possibly+      -- a crash.  A length prediction that is too high overallocates+      -- output space, as if the sequence really were that length.+  , reverseRepeated :: FoldR e+      -- ^ A lazy right-associative fold over the /reverse/+      -- of the desired sequence of field values.+      --+      -- Design Note: We could have used a lazy left-associative fold, but+      -- vectors perform such folds using a left-to-right iteration, instead+      -- of the right-to-left iteration that would yield best performance.+      --+      -- Therefore in order to avoid accidental misuse of 'foldl', we ask+      -- for sequence reversal explicitly.  Thanks to vector fusion rules,+      -- it is fast to 'foldr' on the result of reversing a vector.+  }+  deriving stock (Functor, Generic)++deriving stock instance Eq e => Eq (Repeated e)+deriving stock instance Read e => Read (Repeated e)+deriving stock instance Show e => Show (Repeated e)++nullRepeated :: Repeated e -> Bool+nullRepeated c = null (reverseRepeated c)+{-# INLINE nullRepeated #-}++-- | For each container type, specifies the optimal method for reverse iteration.+type ToRepeated :: forall cr . TYPE cr -> forall er . TYPE er -> Constraint+class ToRepeated c e | c -> e+  where+    -- | Converts to a reverse iteration over the elements.+    toRepeated :: c -> Repeated e++instance forall er (e :: TYPE er) .+         ToRepeated (Repeated e) e+  where+    toRepeated = id+    {-# INLINE toRepeated #-}++instance ToRepeated (Identity a) a+  where+    toRepeated x = ReverseRepeated (Just 1) (FoldR (\f z -> f (runIdentity x) z))+    {-# INLINE toRepeated #-}++instance ToRepeated [a] a+  where+    toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> foldl (flip f) z xs))+      -- Unavoidably reads to the end of the list before presenting the last element.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.List.NonEmpty.NonEmpty a) a+  where+    toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> foldl (flip f) z xs))+      -- Unavoidably reads to the end of the list before presenting the last element.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.Vector.Vector a) a+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Vector.length xs))+      (fromFoldR (Data.Vector.reverse xs))+      -- Vector fusion should convert this to right-to-left iteration.+    {-# INLINE toRepeated #-}++instance Storable a =>+         ToRepeated (Data.Vector.Storable.Vector a) a+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Vector.Storable.length xs))+      (FoldR (\f z -> Data.Vector.Storable.foldr f z (Data.Vector.Storable.reverse xs)))+      -- Vector fusion should convert this to right-to-left iteration.+    {-# INLINE toRepeated #-}++instance Data.Vector.Unboxed.Unbox a =>+         ToRepeated (Data.Vector.Unboxed.Vector a) a+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Vector.Unboxed.length xs))+      (FoldR (\f z -> Data.Vector.Unboxed.foldr f z (Data.Vector.Unboxed.reverse xs)))+      -- Vector fusion should convert this to right-to-left iteration.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.Sequence.Seq a) a+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Sequence.length xs))+      (FoldR (\f z -> foldl (flip f) z xs))+      -- Should present the last element without having to read through the whole sequence.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.Set.Set a) a+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Set.size xs))+      (FoldR (\f z -> foldl (flip f) z xs))+      -- Should present the last element without having to read through the whole sequence.+    {-# INLINE toRepeated #-}++instance ToRepeated Data.IntSet.IntSet Int+  where+    toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> Data.IntSet.foldl (flip f) z xs))+      -- Should present the last element without having to read through the whole sequence.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.Map.Lazy.Map k a) (k, a)+  where+    toRepeated xs = ReverseRepeated+      (Just (Data.Map.Lazy.size xs))+      (FoldR (\f z -> Data.Map.Lazy.foldlWithKey (\a k v -> f (k, v) a) z xs))+      -- Should present the last key-value pair without having to read through the whole map.+    {-# INLINE toRepeated #-}++instance ToRepeated (Data.IntMap.Lazy.IntMap a) (Int, a)+  where+    toRepeated xs = ReverseRepeated+      Nothing+      (FoldR (\f z -> Data.IntMap.Lazy.foldlWithKey (\a k v -> f (k, v) a) z xs))+      -- Should present the last key-value pair without having to read through the whole map.+    {-# INLINE toRepeated #-}++-- | A convenience function that maps a function over a sequence,+-- provided that the relevant types are all lifted.+mapRepeated ::+  forall (c :: Type) (e :: Type) (a :: Type) . ToRepeated c e => (e -> a) -> c -> Repeated a+mapRepeated f xs = fmap f (toRepeated xs)+{-# INLINE mapRepeated #-}

@@ -0,0 +1,80 @@+{-+  Copyright 2025 Arista 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 DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- | Presents right-associative folds as 'Foldable' sequences.+module Proto3.Wire.FoldR+  ( FoldR(..)+  , fromFoldR+  ) where++import Data.Foldable qualified+import Data.Kind (Type)+import GHC.Exts (TYPE)+import GHC.Exts qualified+import Text.Read (Read(..))++-- | Presents a right-associative fold as a 'Foldable' sequence.+--+-- Similar to the @FRList@ example in the documentation for "Data.Foldable",+-- but for generality the element type may be unlifted.  For compatibility+-- with the 'Foldable' type class and to avoid limitations on runtime+-- representation polymorphism, the fold supports only lifted results.+newtype FoldR (a :: TYPE r) = FoldR { applyFoldR :: forall (b :: Type) . (a -> b -> b) -> b -> b }+  deriving stock (Functor)++instance Foldable FoldR+  where+    foldr f z xs = applyFoldR xs f z++instance GHC.Exts.IsList (FoldR a)+  where+    type Item (FoldR a) = a+    fromList = fromFoldR+    toList = Data.Foldable.toList++instance Eq a =>+         Eq (FoldR a)+  where+    x == y = GHC.Exts.toList x == GHC.Exts.toList y++instance Ord a =>+         Ord (FoldR a)+  where+    x <= y = GHC.Exts.toList x <= GHC.Exts.toList y+    x `compare` y = GHC.Exts.toList x `compare` GHC.Exts.toList y++instance Read a =>+         Read (FoldR a)+  where+    readPrec = fmap GHC.Exts.fromList readPrec++instance Show a =>+         Show (FoldR a)+  where+    showsPrec d = showsPrec d . GHC.Exts.toList++-- | Creates a 'FoldR' from the 'foldr' of the given 'Foldable' sequence.+fromFoldR :: Foldable t => t a -> FoldR a+fromFoldR xs = FoldR { applyFoldR = \f z -> foldr f z xs }

@@ -26,6 +26,8 @@  {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}  module Proto3.Wire.Reverse     ( -- * `BuildR` type@@ -79,6 +81,8 @@      -- * Helpful combinators     , foldlRVector+    , repeatedBuildR+    , repeatedFixedPrimR      -- * Exported for testing purposes only.     , testWithUnused@@ -86,6 +90,7 @@  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@@ -100,6 +105,13 @@ import           Data.Vector.Generic           ( Vector ) import           Data.Word                     ( Word8, Word16, Word32, Word64 ) import           Foreign                       ( castPtr, copyBytes )+import           GHC.Exts                      ( Addr#, Int(..), Int# )+#if !MIN_VERSION_bytestring(0,11,0)+import           GHC.Exts                      ( plusAddr# )+#endif+import           GHC.ForeignPtr                ( ForeignPtr(..), ForeignPtrContents )+import           GHC.TypeLits                  ( KnownNat )+import           Proto3.Wire.Encode.Repeated   ( Repeated(..), ToRepeated(..) ) import           Proto3.Wire.Reverse.Internal import qualified Proto3.Wire.Reverse.Prim      as Prim @@ -134,16 +146,33 @@ -- >>> 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 ->-          copyBytes dst (castPtr src) len-    else-      prependChunk bs+#if MIN_VERSION_bytestring(0,11,0)+byteString (BI.BS (ForeignPtr ad ct) (I# len)) = byteStringImpl ad ct len+#else+byteString (BI.PS (ForeignPtr ad ct) (I# off) (I# len)) = byteStringImpl (plusAddr# ad off) ct len+#endif+{-# INLINE byteString #-} +byteStringImpl :: Addr# -> ForeignPtrContents -> Int# -> BuildR+byteStringImpl ad ct len =+#if MIN_VERSION_bytestring(0,11,0)+  let bs = BI.BS (ForeignPtr ad ct) (I# len) in+#else+  let bs = BI.PS (ForeignPtr ad ct) 0 (I# len) in+#endif+  withUnused $ \unused ->+    if I# len <= unused+      then+        unsafeConsume (I# len) $ \dst ->+          BU.unsafeUseAsCString bs $ \src ->+            copyBytes dst (castPtr src) (I# len)+      else+        prependChunk bs+{-# NOINLINE [1] byteStringImpl #-}+{-# RULES+    "byteStringImpl/empty" forall ad ct . byteStringImpl ad ct 0# = mempty+  #-}+ -- | Convert a lazy `BL.ByteString` to a `BuildR` -- -- Warning: evaluating the length will force the lazy `BL.ByteString`'s chunks,@@ -179,6 +208,10 @@                 copyBytes dst (castPtr src) len         else           prependReverseChunks (ReverseChunks(BLI.Chunk c cs))+{-# NOINLINE [1] lazyByteString #-}+{-# RULES+    "lazyByteString/empty" lazyByteString BLI.Empty = mempty+  #-}  -- | Convert a `BS.ShortByteString` to a `BuildR` --@@ -823,9 +856,40 @@ {-# INLINE word64Base128LEVar_inline #-}  -- | Essentially 'foldMap', but iterates right to left for efficiency.+--+-- See also: 'repeatedBuildR' vectorBuildR :: Vector v a => (a -> BuildR) -> v a -> BuildR vectorBuildR f = etaBuildR (foldlRVector (\acc x -> acc <> f x) mempty) {-# INLINE vectorBuildR #-}++-- | Concatenates the given builders, iterating right to left where practical.+--+-- For example:+--+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (repeatedBuildR (map word8 [42,67])))+-- [42,67]+--+-- See also: 'repeatedFixedPrimR', 'vectorBuildR'+repeatedBuildR :: ToRepeated c BuildR => c -> BuildR+repeatedBuildR = etaBuildR (foldr (flip (<>)) mempty . reverseRepeated . toRepeated)+{-# INLINE repeatedBuildR #-}++-- | Concatenates the given fixed-width primitives, iterating right to left where practical+-- and consolidating space checks if the number of primitives has been predicted.+--+-- For example:+--+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (repeatedFixedPrimR (map Proto3.Wire.Reverse.Prim.word8 [42,67])))+-- [42,67]+--+-- See also: 'repeatedBuildR'+repeatedFixedPrimR :: (ToRepeated c (Prim.FixedPrim w), KnownNat w) => c -> BuildR+repeatedFixedPrimR = etaBuildR $ \c ->+  let ReverseRepeated prediction prims = toRepeated c in+  case prediction of+    Nothing -> foldr (\p a -> a <> Prim.liftBoundedPrim (Prim.liftFixedPrim p)) mempty prims+    Just count -> Prim.unsafeReverseFoldMapFixedPrim id count prims+{-# INLINE repeatedFixedPrimR #-}  -- | Exported for testing purposes only. testWithUnused :: (Int -> BuildR) -> BuildR

@@ -99,6 +99,7 @@   , word64Base128LEVar   , word64Base128LEVar_inline   , vectorFixedPrim+  , unsafeReverseFoldMapFixedPrim   ) where  import           Data.Bits                     ( Bits(..) )@@ -844,3 +845,30 @@   where     w = fromInteger (natVal' (proxy# :: Proxy# w)) {-# INLINE vectorFixedPrim #-}++-- | Generalizes 'vectorFixedPrim' by mapping the elements+-- of a sequence of known length to fixed-width primitives+-- and concatenating those primitives /in reverse order/.+--+-- This action is unsafe because a length prediction that is too short+-- causes undefined behavior--possibly a crash.  By contrast, a length+-- prediction that is too long merely overallocates output space.+--+-- (To see how this function could be used to implement 'vectorFixedPrim',+-- note that we can iterate over a vector from right to left by reversing+-- the vector and then performing a right fold on the reversed vector;+-- vector fusion rules should eliminate the intermediate vector.)+unsafeReverseFoldMapFixedPrim ::+  forall w t a .+  (KnownNat w, Foldable t) =>+  (a -> FixedPrim w) ->+  -- | Maximum number of elements.  Overapproximation causes+  -- overallocation; passing an undercount may cause a crash.+  Int ->+  t a ->+  BuildR+unsafeReverseFoldMapFixedPrim f !n = etaBuildR $ \xs ->+    ensure (w * n) (foldr (\x acc -> acc <> unsafeBuildBoundedPrim (liftFixedPrim (f x))) mempty xs)+  where+    w = fromInteger (natVal' (proxy# :: Proxy# w))+{-# INLINE unsafeReverseFoldMapFixedPrim #-}

@@ -14,9 +14,11 @@   limitations under the License. -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  {-# OPTIONS_GHC -Wno-warnings-deprecations #-} @@ -32,20 +34,34 @@ import qualified Data.ByteString.Short as BS import qualified Data.ByteString.Builder.Internal as BBI import           Data.Either           ( isLeft )-import           Data.Maybe            ( fromMaybe )+import           Data.Foldable         ( toList )+import           Data.Functor.Identity ( Identity ) import           Data.Int+import qualified Data.IntMap.Lazy+import qualified Data.IntSet+import qualified Data.Map.Lazy+import           Data.Maybe            ( fromMaybe ) import           Data.List             ( sort ) import qualified Data.List.NonEmpty    as NE+import           Data.Proxy            ( Proxy(..) )+import qualified Data.Sequence+import qualified Data.Set import qualified Data.Text.Lazy        as T import qualified Data.Text.Short       as TS+import           Data.Typeable         ( Typeable, showsTypeRep, typeRep ) import qualified Data.Vector           as V+import qualified Data.Vector.Storable  as VS+import qualified Data.Vector.Unboxed   as VU import           Data.Word             ( Word8, Word64 ) import           Foreign               ( sizeOf )+import qualified GHC.Exts  import           Proto3.Wire+import           Proto3.Wire.FoldR     ( FoldR ) import qualified Proto3.Wire.Builder   as Builder import qualified Proto3.Wire.Reverse   as Reverse import qualified Proto3.Wire.Encode    as Encode+import           Proto3.Wire.Encode.Repeated ( Repeated(..), ToRepeated(..), nullRepeated ) import qualified Proto3.Wire.Decode    as Decode  import qualified Test.DocTest@@ -77,6 +93,7 @@                           , varIntHeavyTests                           , packedLargeTests                           , decodeWireRoundTrip+                          , toRepeatedTests                           ]  data StringOrInt64 = TString T.Text | TInt64 Int64@@ -783,3 +800,73 @@       decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)                              (BL.toStrict encoded)   HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded++data ExpectedCountPrediction c = NoCP | CorrectCP | SameCP (c -> Maybe Int)++toRepeatedTests :: TestTree+toRepeatedTests = testGroup "ToRepeated"+  [ test_nullRepeated+  , test_ToRepeated (SameCP countRepeated) genRepeated (reverse . toList . reverseRepeated)+  , test_ToRepeated CorrectCP QC.arbitrary (toList @Identity @Word8)+  , test_ToRepeated NoCP QC.arbitrary (id @[Word8])+  , test_ToRepeated NoCP ((NE.:|) <$> QC.arbitrary <*> QC.arbitrary) (toList @NE.NonEmpty @Word8)+  , test_ToRepeated CorrectCP (fmap V.fromList QC.arbitrary) (V.toList @Word8)+  , test_ToRepeated CorrectCP (fmap VS.fromList QC.arbitrary) (VS.toList @Word8)+  , test_ToRepeated CorrectCP (fmap VU.fromList QC.arbitrary) (VU.toList @Word8)+  , test_ToRepeated CorrectCP QC.arbitrary (toList @Data.Sequence.Seq @Word8)+  , test_ToRepeated CorrectCP QC.arbitrary (Data.Set.toAscList @Word8)+  , test_ToRepeated NoCP QC.arbitrary Data.IntSet.toAscList+  , test_ToRepeated CorrectCP QC.arbitrary (Data.Map.Lazy.toAscList @Int8 @Word8)+  , test_ToRepeated NoCP QC.arbitrary (Data.IntMap.Lazy.toAscList @Word8)+  ]+  where+    genRepeated :: QC.Gen (Repeated Word8)+    genRepeated = do+      predict <- QC.arbitrary+      xs <- QC.arbitrary+      pure ReverseRepeated+        { countRepeated = if predict then Just (length xs) else Nothing+        , reverseRepeated = GHC.Exts.fromList xs+        }++    test_nullRepeated :: TestTree+    test_nullRepeated =+      QC.testProperty "nullRepeated" $+        QC.forAll genRepeated $ \c ->+          nullRepeated c === null (reverseRepeated c)++    test_ToRepeated ::+      forall c e .+      ( ToRepeated c e+      , Show c+      , Typeable c+      , Eq e+      , Show e+      ) =>+      ExpectedCountPrediction c ->+      (QC.Gen c) ->+      (c -> [e]) ->+      TestTree+    test_ToRepeated expectedCP gen cToList =+      let cRep = typeRep (Proxy :: Proxy c) in+      QC.testProperty (showString "toRepeated @(" $ showsTypeRep cRep ")") $+        QC.forAll gen $ \(c :: c) ->+          let es :: [e]+              es = cToList c++              prediction :: Maybe Int+              reversed :: FoldR e+              ReverseRepeated prediction reversed = toRepeated c+          in+            QC.counterexample "correctly reversed elements" (toList reversed === reverse es)+            QC..&&.+            QC.counterexample "correct count prediction if any"+              (all @Maybe (== length es) prediction)+            QC..&&.+            case expectedCP of+              NoCP ->+                QC.counterexample "no count prediction" (prediction === Nothing)+              CorrectCP ->+                QC.counterexample "correct count prediction" (prediction === Just (length es))+              SameCP expected ->+                QC.counterexample "unchanged count prediction" (prediction === expected c)