proto3-wire 1.4.6 → 1.5.0

raw patch · 11 files changed

+1473/−260 lines, 11 filesdep −unordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies removed: unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• proto3-wire.cabal +6/−3
• src/Proto3/Wire/Decode.hs +4/−3
• src/Proto3/Wire/Encode.hs +143/−12
• src/Proto3/Wire/Encode/Repeated.hs +481/−101
• src/Proto3/Wire/FoldR.hs +1/−0
• src/Proto3/Wire/Reverse.hs +15/−11
• src/Proto3/Wire/Reverse/Internal.hs +242/−35
• src/Proto3/Wire/Reverse/Prim.hs +46/−29
• src/Proto3/Wire/Types.hs +5/−3
• test/Main.hs +517/−63

@@ -1,3 +1,16 @@+1.5.0+  - As a breaking change, modify `Repeated` and `ToRepeated` to use `foldMap`-style+    folds and thereby avoid allocation of `BuildR` functions on the heap.  Use+    of `FoldR` seemed to force such allocation, even when using `oneShot`.+  - Use `oneShot` in `BuildR` and `FixedPrim` to discourage allocation+    of such function newtypes on the heap in other scenarios.+  - Add `BuildM` and associated features for monadic building.+  - Add `PackedField` to support packed fields in a uniform fashion,+    and directly implement omission of such a field when it is empty.+  - Add `embeddedIfNonempty` as a way to omit empty length-delimited fields.+  - Deprecate `FoldR` and `unsafeReverseFoldMapFixedPrim` because+    we have stopped using them and plan to remove them in future.+ 1.4.6   - Add a decoder combinator named `optional` for optional fields of primitive type. 

@@ -1,13 +1,13 @@ cabal-version: >=1.10  name:         proto3-wire-version:      1.4.6+version:      1.5.0 synopsis:     A low-level implementation of the Protocol Buffers (version 3) wire format license:      Apache-2.0 license-file: LICENSE author:       Arista Networks <opensource@awakesecurity.com> maintainer:   Arista Networks <opensource@awakesecurity.com>-copyright:    2017 Awake Security, 2021 Arista Networks+copyright:    2017 Awake Security, 2021-2026 Arista Networks category:     Codec build-type:   Simple @@ -27,6 +27,8 @@     -O2     -fobject-code     -Wall+    -Wmissing-deriving-strategies+    -Wunused-packages    -- 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.@@ -47,7 +49,6 @@     , text >= 0.2 && <2.2     , text-short ==0.1.*     , transformers >=0.5.6.2 && <0.7-    , unordered-containers >= 0.1.0.0 && <0.3     , vector >=0.12.0.2 && <0.14     , QuickCheck >=2.8 && <3.0     , word-compat >= 0.0.6@@ -100,6 +101,8 @@   ghc-options:     -O2     -Wall+    -Wmissing-deriving-strategies+    -Wunused-packages    build-depends:       base >= 4 && < 5

@@ -25,6 +25,7 @@ {-# LANGUAGE BangPatterns               #-} {-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE PatternGuards              #-}@@ -124,7 +125,7 @@                  | Fixed32Field B.ByteString                  | Fixed64Field B.ByteString                  | LengthDelimitedField B.ByteString-    deriving (Show, Eq)+    deriving stock (Show, Eq)  -- | Convert key-value pairs to a map of keys to a sequence of values with that -- key, in their reverse occurrence order.@@ -257,7 +258,7 @@                 -- embedded message.                 EmbeddedError Text                               (Maybe ParseError)-    deriving (Show, Eq, Ord)+    deriving stock (Show, Eq, Ord)  -- | This library does not use this instance, but it is provided for convenience, -- so that 'ParseError' may be used with functions like `throwIO`@@ -277,7 +278,7 @@ -- 'Parser's can be combined using the 'Applicative', 'Monad' and 'Alternative' -- instances. newtype Parser input a = Parser { runParser :: input -> Either ParseError a }-    deriving Functor+    deriving stock Functor  instance Applicative (Parser input) where     pure = Parser . const . pure

@@ -1,5 +1,5 @@ {--  Copyright 2016 Awake Networks+  Copyright 2016-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -38,6 +38,7 @@ -- > 1 `strings` Just "some string" <> -- > 2 `strings` [ "foo", "bar", "baz" ] +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-}@@ -94,9 +95,11 @@     , shortByteString       -- * Embedded Messages     , embedded+    , embeddedIfNonempty       -- * Folds     , repeatedMessageBuilder       -- * Packed repeated fields+    , PackedField(..)     , packedVarints     , packedVarintsV     , packedInt32R@@ -135,7 +138,7 @@ import qualified Data.Text.Lazy                as Text.Lazy import qualified Data.Text.Short               as Text.Short import           Data.Vector.Generic           ( Vector )-import           Data.Word                     ( Word8, Word32, Word64 )+import           Data.Word                     ( Word8, Word16, Word32, Word64 ) import           GHC.TypeLits                  ( KnownNat, Nat, type (+) ) import           Parameterized.Data.Semigroup  ( PNullary, PSemigroup(..),                                                  (&<>) )@@ -512,16 +515,7 @@ -- >>> 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 #-}+bytesIfNonempty !num = embeddedIfNonempty num . MessageBuilder {-# INLINE bytesIfNonempty #-}  -- | Encode a UTF-8 string.@@ -602,6 +596,13 @@   etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedBuildR . mapRepeated f) {-# INLINE packedVariableWidthFieldR #-} +-- | Like 'packedVariableWidthFieldR' but uses omission for zero elements.+packedVariableWidthFieldRIfNonempty ::+  ToRepeated c a => (a -> RB.BuildR) -> FieldNumber -> c -> MessageBuilder+packedVariableWidthFieldRIfNonempty f !num =+  etaMessageBuilder (embeddedIfNonempty num . MessageBuilder . RB.repeatedBuildR . mapRepeated f)+{-# INLINE packedVariableWidthFieldRIfNonempty #-}+ -- | Encodes a packed repeated field whose elements never vary in width. packedFixedWidthFieldR ::   (ToRepeated c a, KnownNat w) => (a -> Prim.FixedPrim w) -> FieldNumber -> c -> MessageBuilder@@ -609,6 +610,83 @@   etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedFixedPrimR . mapRepeated f) {-# INLINE packedFixedWidthFieldR #-} +-- | Like 'packedFixedWidthFieldR' but uses omission for zero elements.+packedFixedWidthFieldRIfNonempty ::+  (ToRepeated c a, KnownNat w) => (a -> Prim.FixedPrim w) -> FieldNumber -> c -> MessageBuilder+packedFixedWidthFieldRIfNonempty f !num =+  etaMessageBuilder (embeddedIfNonempty num . MessageBuilder . RB.repeatedFixedPrimR . mapRepeated f)+{-# INLINE packedFixedWidthFieldRIfNonempty #-}++-- | Chooses an appropriate encoder for the specified packed repeated field and sequence type.+class ToRepeated c e =>+      PackedField wt c e+  where+    -- | Normally emits a packed repeated field.  But if there is exactly+    -- one element in the sequence, then this method uses unpacked format+    -- because it is slightly shorter.  And if the sequence is empty then+    -- this method omits the encoding entirely.+    --+    -- The caller must specify the wire type and must also perform+    -- any required integral conversions such as zig-zag encoding+    -- (perhaps by using 'mapRepeated'.)+    packedField :: FieldNumber -> c -> MessageBuilder++instance ToRepeated c Word64 =>+         PackedField 'Varint c Word64+  where+    packedField = packedVariableWidthFieldRIfNonempty RB.word64Base128LEVar+    {-# INLINE packedField #-}++instance ToRepeated c Word32 =>+         PackedField 'Varint c Word32+  where+    packedField = packedVariableWidthFieldRIfNonempty RB.word32Base128LEVar+    {-# INLINE packedField #-}++instance ToRepeated c Word16 =>+         PackedField 'Varint c Word16+  where+    packedField = packedVariableWidthFieldRIfNonempty (RB.word32Base128LEVar . fromIntegral)+      -- In future we might add a more specialized, more compact function named @word16Base128LEVar@.+    {-# INLINE packedField #-}++instance ToRepeated c Word8 =>+         PackedField 'Varint c Word8+  where+    packedField = packedVariableWidthFieldRIfNonempty (RB.word32Base128LEVar . fromIntegral)+      -- In future we might add a more specialized, more compact function named @word8Base128LEVar@.+    {-# INLINE packedField #-}++instance ToRepeated c Bool =>+         PackedField 'Varint c Bool+  where+    packedField = packedFixedWidthFieldRIfNonempty (Prim.word8 . fromIntegral . fromEnum)+    {-# INLINE packedField #-}++instance ToRepeated c Word32 =>+         PackedField 'Fixed32 c Word32+  where+    packedField = packedFixedWidthFieldRIfNonempty Prim.word32LE+    {-# INLINE packedField #-}++instance ToRepeated c Float =>+         PackedField 'Fixed32 c Float+  where+    packedField = packedFixedWidthFieldRIfNonempty Prim.floatLE+    {-# INLINE packedField #-}++instance ToRepeated c Word64 =>+         PackedField 'Fixed64 c Word64+  where+    packedField = packedFixedWidthFieldRIfNonempty Prim.word64LE+    {-# INLINE packedField #-}++instance ToRepeated c Double =>+         PackedField 'Fixed64 c Double+  where+    packedField = packedFixedWidthFieldRIfNonempty Prim.doubleLE+    {-# INLINE packedField #-}+ -- | Encode varints in the space-efficient packed format. -- But consider 'packedVarintsV' or 'packedVarintsR', either of which may be faster. --@@ -624,6 +702,8 @@ -- -- Generalizes 'packedVarintsV', provided that any new instance -- of 'Vector' is given a corresponding instance of 'ToRepeated'.+--+-- But use 'packedField' to omit the field when there are zero elements. packedVarints64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder packedVarints64R = packedVariableWidthFieldR RB.word64Base128LEVar {-# INLINE packedVarints64R #-}@@ -631,6 +711,8 @@ -- | Like 'packedVarints64R' but supports only 32-bit inputs, -- which reduces on executable size in situations where we do -- not need to support larger values.+--+-- But use 'packedField' to omit the field when there are zero elements. packedVarints32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder packedVarints32R = packedVariableWidthFieldR RB.word32Base128LEVar {-# INLINE packedVarints32R #-}@@ -659,6 +741,8 @@ -- 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>+--+-- But use 'packedField' to omit the field when there are zero elements. packedInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder packedInt32R !num xs =   packedVarints64R num (mapRepeated (fromIntegral @Int32 @Word64) xs)@@ -670,6 +754,8 @@ -- -- >>> packedInt64R @[_] 1 [42, -42] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\v*\214\255\255\255\255\255\255\255\255\SOH"+--+-- But use 'packedField' to omit the field when there are zero elements. packedInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder packedInt64R !num xs =   packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64) xs)@@ -681,6 +767,8 @@ -- -- >>> packedUInt32R @[_] 1 [42, 43, maxBound] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\a*+\255\255\255\255\SI"+--+-- But use 'packedField' to omit the field when there are zero elements. packedUInt32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder packedUInt32R = packedVarints32R {-# INLINE packedUInt32R #-}@@ -691,6 +779,8 @@ -- -- >>> packedUInt64R @[_] 1 [42, 43, maxBound] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f*+\255\255\255\255\255\255\255\255\255\SOH"+--+-- But use 'packedField' to omit the field when there are zero elements. packedUInt64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder packedUInt64R = packedVarints64R {-# INLINE packedUInt64R #-}@@ -701,6 +791,8 @@ -- -- >>> packedSInt32R @[_] 1 [-42, maxBound, minBound] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\vS\254\255\255\255\SI\255\255\255\255\SI"+--+-- But use 'packedField' to omit the field when there are zero elements. packedSInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder packedSInt32R !num xs =   packedVarints32R num (mapRepeated (fromIntegral @Int32 @Word32 . zigZagEncode) xs)@@ -712,6 +804,8 @@ -- -- >>> 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"+--+-- But use 'packedField' to omit the field when there are zero elements. packedSInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder packedSInt64R !num xs =   packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64 . zigZagEncode) xs)@@ -726,6 +820,8 @@ -- -- >>> packedBoolsR @[_] 1 [True, False] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"+--+-- But use 'packedField' to omit the field when there are zero elements. packedBoolsR :: ToRepeated c Bool => FieldNumber -> c -> MessageBuilder packedBoolsR = packedFixedWidthFieldR (Prim.word8 . fromIntegral . fromEnum) {-# INLINE packedBoolsR #-}@@ -761,6 +857,8 @@ -- -- >>> packedFixed32R @[_] 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"+--+-- But use 'packedField' to omit the field when there are zero elements. packedFixed32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder packedFixed32R = packedFixedWidthFieldR Prim.word32LE {-# INLINE packedFixed32R #-}@@ -795,6 +893,8 @@ -- -- >>> 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"+--+-- But use 'packedField' to omit the field when there are zero elements. packedFixed64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder packedFixed64R = packedFixedWidthFieldR Prim.word64LE {-# INLINE packedFixed64R #-}@@ -818,6 +918,8 @@ -- -- >>> packedSFixed32R @[_] 1 [1, -2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\254\255\255\255\ETX\NUL\NUL\NUL"+--+-- But use 'packedField' to omit the field when there are zero elements. packedSFixed32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder packedSFixed32R = packedFixedWidthFieldR Prim.int32LE {-# INLINE packedSFixed32R #-}@@ -828,6 +930,8 @@ -- -- >>> 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"+--+-- But use 'packedField' to omit the field when there are zero elements. packedSFixed64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder packedSFixed64R = packedFixedWidthFieldR Prim.int64LE {-# INLINE packedSFixed64R #-}@@ -850,6 +954,8 @@ -- -- >>> packedFloatsR @[_] 1 [1, 2, 3] -- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"+--+-- But use 'packedField' to omit the field when there are zero elements. packedFloatsR :: ToRepeated c Float => FieldNumber -> c -> MessageBuilder packedFloatsR = packedFixedWidthFieldR Prim.floatLE {-# INLINE packedFloatsR #-}@@ -885,6 +991,8 @@ -- -- >>> 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@"+--+-- But use 'packedField' to omit the field when there are zero elements. packedDoublesR :: ToRepeated c Double => FieldNumber -> c -> MessageBuilder packedDoublesR = packedFixedWidthFieldR Prim.doubleLE {-# INLINE packedDoublesR #-}@@ -922,3 +1030,26 @@       Prim.wordBase128LEVar (fromIntegral @Int @Word len)     {-# INLINE prefix #-} {-# INLINE embedded #-}++-- | Like 'embedded' 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.+--+-- For example:+--+-- >>> 1 `embeddedIfNonempty` mempty+-- Proto3.Wire.Encode.unsafeFromLazyByteString ""+-- >>> 1 `embeddedIfNonempty` (1 `string` "this message" <> 2 `string` " is embedded")+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\FS\n\fthis message\DC2\f is embedded"+embeddedIfNonempty :: FieldNumber -> MessageBuilder -> MessageBuilder+embeddedIfNonempty = \(!num) (MessageBuilder bb) ->+    MessageBuilder (RB.withLengthOf (prefix num) bb)+  where+    prefix !num len+      | 0 < len = Prim.liftBoundedPrim $+          unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>+          Prim.wordBase128LEVar (fromIntegral @Int @Word len)+      | otherwise =+          mempty+    {-# INLINE prefix #-}+{-# INLINE embeddedIfNonempty #-}

@@ -1,5 +1,5 @@ {--  Copyright 2025 Arista Networks+  Copyright 2025-2026 Arista Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -14,172 +14,552 @@   limitations under the License. -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Presents right-associative folds as 'Foldable' sequences. module Proto3.Wire.Encode.Repeated-  ( Repeated(..)+  ( Repeated   , nullRepeated-  , ToRepeated(..)+  , predictRepeated+  , foldMapRepeated+  , foldMapRepeated'+  , foldlRepeated+  , foldrRepeated'+  , toRepeated   , mapRepeated+  , mapMaybeRepeated+  , mapFoldRepeated+  , Reverse(..)+  , Count(Count, ..)+  , ToRepeated(..)   ) where +import Data.Coerce (coerce) 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.List.NonEmpty (NonEmpty) import Data.Map.Lazy qualified+import Data.Monoid (Endo(..))+import Data.Semigroup (All(..), Dual(..)) 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)+import GHC.Exts (inline, oneShot)+import GHC.Exts qualified (IsList(..))+import Text.Read (Read(..)) --- | 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.+-- | Expresses a sequence of values for encoding as a repeated field.+--+-- This type constructor is not 'Foldable' because it would not satisfy+-- the efficiency assumptions of that type class.  In particular, it is+-- optimized for left associativity.+data Repeated e+  where+    MapRepeated ::+      forall c a e .+      ToRepeated c a =>+      -- | Maps the elements of the sequence individually.+      -- /without/ modifing the number or order of elements.       ---      -- 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.+      -- In this case 'predictRepeatedSource' remains useful.+      (a -> e) ->+      -- | The container providing the sequence.+      c ->+      Repeated e++    BindRepeated ::+      forall c a e .+      ToRepeated c a =>+      -- | Maps each element of the sequence to zero or more new+      -- elements and concatenates the results by transforming+      -- the fold to be passed to 'foldMapRepeatedSource'.       ---      -- 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)+      -- We cannot make use of 'predictRepeatedSource' in this case.+      (forall m . Monoid m => (e -> m) -> a -> m) ->+      -- | The container providing the sequence.+      c ->+      Repeated e -deriving stock instance Eq e => Eq (Repeated e)-deriving stock instance Read e => Read (Repeated e)-deriving stock instance Show e => Show (Repeated e)+instance Functor Repeated+  where+    fmap f (MapRepeated g xs) = MapRepeated (\x -> f (g x)) xs+    fmap f (BindRepeated g xs) = BindRepeated (\j x -> g (\y -> j (f y)) x) xs+    {-# INLINE fmap #-} +instance GHC.Exts.IsList (Repeated e)+  where+    type Item (Repeated e) = e++    fromList xs = MapRepeated id xs++    fromListN n xs = MapRepeated id (UnsafeCount n xs)++    toList (MapRepeated g xs) = appEndo (foldMapRepeatedSource (\x -> Endo (g x :)) xs) []+    toList (BindRepeated g xs) = appEndo (foldMapRepeatedSource (\x -> g (\y -> Endo (y :)) x) xs) []++instance Eq e =>+         Eq (Repeated e)+  where+    x == y = GHC.Exts.toList x == GHC.Exts.toList y++instance Read e =>+         Read (Repeated e)+  where+    readPrec = fmap GHC.Exts.fromList readListPrec++instance Show e =>+         Show (Repeated e)+  where+    showsPrec _ = showList . GHC.Exts.toList++-- | Is the given sequence empty? nullRepeated :: Repeated e -> Bool-nullRepeated c = null (reverseRepeated c)+nullRepeated (MapRepeated _ xs) =+  case predictRepeatedSource xs of+    Just c -> c <= 0+    Nothing -> getAll (getDual (foldMapRepeatedSource (\_ -> Dual (All False)) xs))+nullRepeated (BindRepeated g xs) =+  getAll (getDual (foldMapRepeatedSource (\x -> g (\_ -> Dual (All False)) x) xs)) {-# INLINE nullRepeated #-} +-- | May predict the number of elements in the sequence, but does+-- so only when it is practical to do so accurately and quickly.+--+-- More specifically, this function delegates to 'predictRepeatedSource'+-- but only when the source sequence has not been filtered by functions+-- such as 'mapMaybeRepeated', and 'predictRepeatedSource' may itself+-- decline to predict the number of elements in the source sequence.+--+-- For example, it is easy to predict the length of a vector, but+-- we would have to prescan a lazy list to discover its length.+predictRepeated :: ToRepeated c e => c -> Maybe Int+predictRepeated = predictRepeatedSource . toRepeated+{-# INLINE predictRepeated #-}++-- | Equivalent to a lazy 'foldMap' over the given sequence.+foldMapRepeated :: (ToRepeated c e, Monoid m) => (e -> m) -> c -> m+foldMapRepeated f = foldMapRepeatedSource f . toRepeated+{-# INLINE foldMapRepeated #-}++-- | Like 'foldMapRepeated', but strictly accumulates from the end of the sequence.+--+-- Typically you should not use this fold with builders, but it can be+-- used to gather statistics about a sequence, or for other purposes.+foldMapRepeated' :: (ToRepeated c e, Monoid m) => (e -> m) -> c -> m+foldMapRepeated' f = foldrRepeated' (\x acc -> f x <> acc) mempty+    -- Curiously, a newtype around the 'Monoid' that strictifies the right operand+    -- is insufficient to cause GHC 9.8.2 to pass the accumulator to recursive calls+    -- instead of applying '<>' after making the recursive call.  It is not clear why.+    -- That is why we instead use `foldrRepeated'` here.+{-# INLINE foldMapRepeated' #-}++-- | A left-associative lazy fold that accumulates from the beginning of the sequence.+--+-- Typically you should not use this fold with builders, but it can+-- be used to gather information from the end of the sequence, such+-- as the last element having a particular property.+foldlRepeated :: ToRepeated c e => (b -> e -> b) -> b -> c -> b+foldlRepeated f = \z xs ->+  getDual (foldMapRepeated (\x -> Dual (Endo (\b -> f b x))) xs) `appEndo` z+{-# INLINE foldlRepeated #-}++-- | A right-associative strict fold that accumulates from the end of the sequence.+--+-- Typically you should not use this fold with builders, but it can be+-- used to gather statistics about a sequence, or for other purposes.+foldrRepeated' :: ToRepeated c e => (e -> b -> b) -> b -> c -> b+foldrRepeated' f = \z xs ->+  foldMapRepeated (\x -> Endo (oneShot (\b -> b `seq` f x b))) xs `appEndo` z+{-# INLINE foldrRepeated' #-}++-- | Converts to 'Repeated' from a sequence supporting 'ToRepeated'.+toRepeated :: ToRepeated c e => c -> Repeated e+toRepeated = MapRepeated id+{-# INLINE [1] toRepeated #-}+{-# RULES "toRepeated@Repeated" toRepeated = id #-}++-- | Maps a function over the elements of a 'Repeated' sequence.+mapRepeated :: ToRepeated c a => (a -> e) -> c -> Repeated e+mapRepeated f = fmap f . toRepeated+{-# INLINE mapRepeated #-}++-- | Maps and filters a 'Repeated' sequence, with+-- the same semantics as `Data.Maybe.mapMaybe`.+--+-- Necessarily invalidates any predicted number of elements.+mapMaybeRepeated :: ToRepeated c a => (a -> Maybe e) -> c -> Repeated e+mapMaybeRepeated f = mapFoldRepeated (\j a -> foldMap j (f a))+{-# INLINE mapMaybeRepeated #-}++-- | Maps each element of the sequence to zero or more new+-- elements and concatenates the results by transforming+-- the fold to be passed to 'foldMapRepeatedSource'.+--+-- The semantics are similar to 'foldMap' and 'foldMapRepeated',+-- but in this case the result is another 'Repeated' rather than+-- a final monoidal result.  (Though conceptually one can view+-- 'Repeated' as a 'Monoid' under concatenation, in practice+-- we have not yet implemented such an operation.)+--+-- NOTE: As with 'foldMapRepeatedSource', it is preferred that+-- the fold transformation that you pass to this function allow+-- the fold that is eventually passed in to demand the elements+-- that it expects in /reverse/ order without harming efficiency+-- (because that fold typically creates a reverse builder).+--+-- For example, the given fold transformer might create a subsequence+-- of new elements from a single element of the original sequence,+-- then use 'foldMapRepeated' on that subsequence in order to present+-- the new elements in reverse order to the extent that is practical.+--+-- Necessarily invalidates any predicted number of elements.+--+-- For example, @mapMaybeRepeated f = mapFoldRepeated (\h -> foldMap h . f)@.+mapFoldRepeated :: ToRepeated c a => (forall m . Monoid m => (e -> m) -> a -> m) -> c -> Repeated e+mapFoldRepeated f = \xs -> case toRepeated xs of+  MapRepeated g ys -> BindRepeated (\j y -> inline (f (inline j) (inline (g y)))) ys+  BindRepeated g ys -> BindRepeated (\j y -> inline (g (inline f (\e -> inline (j e))) y)) ys+{-# INLINE mapFoldRepeated #-}+ -- | For each container type, specifies the optimal method for reverse iteration.-type ToRepeated :: forall cr . TYPE cr -> forall er . TYPE er -> Constraint+--+-- When instantiating this type class for a particular data structure, please also+-- instantiate it for 'Reverse' of that data structure, in the process exploiting+-- any special features that speed iteration in the indicated order.  (The exception+-- is the instance for 'Repeated' itself, for which there is no general reversal.)+--+-- See Also: 'Reverse' class ToRepeated c e | c -> e   where-    -- | Converts to a reverse iteration over the elements.-    toRepeated :: c -> Repeated e+    -- | 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, and may+    -- cause use of packed format where unpacked format would be smaller.+    -- And there may be other, unpredictable effects from incorrect+    -- predictions.  Therefore if you are in doubt, use 'Nothing'.+    predictRepeatedSource :: c -> Maybe Int -instance forall er (e :: TYPE er) .-         ToRepeated (Repeated e) e+    -- | Performs a lazy 'foldMap' of the given function over the desired+    -- sequence of field values, preferably but not necessarily optimized+    -- so that demanding the elements in /reverse/ order is efficient+    -- (because we encode using a reverse builder).+    --+    -- The worst case arises when folding over a list because we must go+    -- to the end before we can build the last element, which is the one+    -- we must encode first.  In this case we build up calling context+    -- for the other elements.  But allocating a reversed list would be+    -- about the same overhead, so there is no point in doing that.  But+    -- if you can build the original list in reverse order to start with,+    -- then you can wrap the list in 'Reverse' to semantically reverse+    -- it while iterating in the natural order for a list data structure.+    --+    -- With vectors we can semantically reverse the vector and then use+    -- 'Dual' within our fold to restore the original order.  Thanks to+    -- vector fusion rules, the actual effect will be to iterate backward+    -- through the existing vector, /not/ to allocate a reversed vector.+    foldMapRepeatedSource :: Monoid m => (e -> m) -> c -> m++instance ToRepeated (Repeated e) e   where-    toRepeated = id-    {-# INLINE toRepeated #-}+    predictRepeatedSource (MapRepeated _ ys) = predictRepeatedSource ys+    predictRepeatedSource (BindRepeated _ _) = Nothing+    {-# INLINE predictRepeatedSource #-} -instance ToRepeated (Identity a) a+    foldMapRepeatedSource f (MapRepeated g ys) = foldMapRepeatedSource (\y -> f (g y)) ys+    foldMapRepeatedSource f (BindRepeated g ys) = foldMapRepeatedSource (\y -> g f y) ys+    {-# INLINE foldMapRepeatedSource #-}++-- | As viewed through 'ToRepeated', reverses the order of a sequence.  But+-- this conceptual reversal cannot alter its performance characteristics.+--+-- For example, conceptually reversing @"CBA"@ is functionally+-- equivalent to using @"ABC"@ as-is, but performs better with reverse+-- builders because @\'C\'@ is the most accessible element of @"CBA"@.+--+-- We intentionally avoid defining a general instance of+-- @'ToRepeated' (Reverse c) e@ in terms of @'ToRepeated' c e@+-- because different data structures provide different options+-- for iterating in a particular order.  In particular, vectors+-- allow fast iteration in either order but we need to know that+-- they are vectors in order to exploit those features.+newtype Reverse c = Reverse c++-- | As viewed through 'ToRepeated', predicts the number of elements in a sequence,+-- replacing the behavior of 'predictRepeatedSource' for the underlying sequence.+--+-- For example, if you happen to know the length of a list specifying the elements+-- of a repeated field of fixed-width type, you can improve encoder performance by+-- providing that information to the encoder by means of this wrapper.+--+-- 'Count' should be the outer wrapper if 'Reverse' is also used.  That way+-- the generic instance of 'ToRepeated' for 'Counter' can apply, regardless+-- of the more specific instance for 'Reverse' of a specific sequence type.+data Count c = UnsafeCount Int c+  -- ^ This data constructor is unsafe because it /ASSUMES/ the element count is accurate.+  -- See 'predictRepeatedSource' for what can happen if this count is incorrect.++{-# COMPLETE Count #-}++pattern Count :: Int -> c -> Count c+pattern Count n c <- UnsafeCount n c++instance ToRepeated c e =>+         ToRepeated (Count c) e   where-    toRepeated x = ReverseRepeated (Just 1) (FoldR (\f z -> f (runIdentity x) z))-    {-# INLINE toRepeated #-}+    predictRepeatedSource = \(Count n _) -> Just n+    {-# INLINE predictRepeatedSource #-} -instance ToRepeated [a] a+    foldMapRepeatedSource = \f (Count _ xs) -> foldMapRepeatedSource f xs+    {-# INLINE foldMapRepeatedSource #-}++-- | Presents the elements of a list in order.+--+-- Note that @'Reverse' [e]@ performs better, but+-- requires you to build the list in reverse order.+instance ToRepeated [e] e   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 #-}+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-} -instance ToRepeated (Data.List.NonEmpty.NonEmpty a) a+    foldMapRepeatedSource = foldMap+      -- Reads to the end of the list before presenting the last element,+      -- but we think that explicitly reversing the list would be slower.+    {-# INLINE foldMapRepeatedSource #-}++-- | Presents the elements of a list in /reverse/ order.+--+-- Performs better than plain @[e]@, but requires+-- that you to build the list in reverse order.+instance ToRepeated (Reverse [e]) e   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 #-}+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource = \f (Reverse xs) -> getDual (foldMap (\x -> Dual (f x)) xs)+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (NonEmpty e) e+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = foldMap+      -- Reads to the end of the list before presenting the last element,+      -- but we think that explicitly reversing the list would be slower.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (NonEmpty e)) e+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) -> getDual (foldMap (\x -> Dual (f x)) xs)+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Identity a) a+  where+    predictRepeatedSource = \_ -> Just 1+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = coerce+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Identity a)) a+  where+    predictRepeatedSource = \_ -> Just 1+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = coerce+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Vector.length+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource =+      \f xs -> getDual (Data.Vector.foldMap (Dual . f) (Data.Vector.reverse xs))+      -- Vector fusion should convert this to reverse iteration.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Data.Vector.Vector a)) a+  where+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Vector.length xs)+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) -> getDual (Data.Vector.foldMap (\x -> Dual (f x)) xs)+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Vector.Storable.length+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource = \f xs ->+      getDual (Data.Vector.Storable.foldMap (\x -> Dual (f x)) (Data.Vector.Storable.reverse xs))+      -- Vector fusion should convert this to reverse iteration.+    {-# INLINE foldMapRepeatedSource #-}++instance Storable a =>+         ToRepeated (Reverse (Data.Vector.Storable.Vector a)) a+  where+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Vector.Storable.length xs)+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) ->+      getDual (Data.Vector.Storable.foldMap (\x -> Dual (f x)) xs)+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Vector.Unboxed.length+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource = \f xs ->+      getDual (Data.Vector.Unboxed.foldMap (\x -> Dual (f x)) (Data.Vector.Unboxed.reverse xs))+      -- Vector fusion should convert this to reverse iteration.+    {-# INLINE foldMapRepeatedSource #-}++instance Data.Vector.Unboxed.Unbox a =>+         ToRepeated (Reverse (Data.Vector.Unboxed.Vector a)) a+  where+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Vector.Unboxed.length xs)+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) ->+      getDual (Data.Vector.Unboxed.foldMap (\x -> Dual (f x)) xs)+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Sequence.length+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource = foldMap+      -- Should present the last element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Data.Sequence.Seq a)) a+  where+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Sequence.length xs)+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) -> getDual (foldMap (\x -> Dual (f x)) xs)+      -- Should present the first element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Set.size+    {-# INLINE predictRepeatedSource #-} -instance ToRepeated Data.IntSet.IntSet Int+    foldMapRepeatedSource = foldMap+      -- Should present the last element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Data.Set.Set a)) a   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 #-}+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Set.size xs)+    {-# INLINE predictRepeatedSource #-} +    foldMapRepeatedSource = \f (Reverse xs) -> getDual (foldMap (\x -> Dual (f x)) xs)+      -- Should present the first element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated Data.IntSet.IntSet Data.IntSet.Key+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource =+#if MIN_VERSION_containers(0,8,0)+      Data.IntSet.foldMap+#else+      \f xs -> Data.IntSet.foldl (\a x -> a <> f x) mempty xs+#endif+      -- Should present the last element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse Data.IntSet.IntSet) Data.IntSet.Key+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource =+#if MIN_VERSION_containers(0,8,0)+      \f (Reverse xs) -> getDual (Data.IntSet.foldMap (\x -> Dual (f x)) xs+#else+      \f (Reverse xs) -> Data.IntSet.foldr (\x a -> a <> f x) mempty xs+#endif+      -- Should present the first element without having to read through the whole sequence,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}+ 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 #-}+    predictRepeatedSource = Just . Data.Map.Lazy.size+    {-# INLINE predictRepeatedSource #-} -instance ToRepeated (Data.IntMap.Lazy.IntMap a) (Int, a)+    foldMapRepeatedSource = \f -> Data.Map.Lazy.foldMapWithKey (\k v -> f (k, v))+      -- Should present the last key-value pair without having to read through the whole map,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Data.Map.Lazy.Map k a)) (k, 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 #-}+    predictRepeatedSource = \(Reverse xs) -> Just (Data.Map.Lazy.size xs)+    {-# INLINE predictRepeatedSource #-} --- | 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 #-}+    foldMapRepeatedSource = \f (Reverse xs) ->+      getDual (Data.Map.Lazy.foldMapWithKey (\k v -> Dual (f (k, v))) xs)+      -- Should present the first key-value pair without having to read through the whole map,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Data.IntMap.Lazy.IntMap a) (Data.IntMap.Lazy.Key, a)+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f -> Data.IntMap.Lazy.foldMapWithKey (\k v -> f (k, v))+      -- Should present the last key-value pair without having to read through the whole map,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}++instance ToRepeated (Reverse (Data.IntMap.Lazy.IntMap a)) (Data.IntMap.Lazy.Key, a)+  where+    predictRepeatedSource = \_ -> Nothing+    {-# INLINE predictRepeatedSource #-}++    foldMapRepeatedSource = \f (Reverse xs) ->+      getDual (Data.IntMap.Lazy.foldMapWithKey (\k v -> Dual (f (k, v))) xs)+      -- Should present the last key-value pair without having to read through the whole map,+      -- though we may have to descend to the bottom of the tree.+    {-# INLINE foldMapRepeatedSource #-}

@@ -25,6 +25,7 @@  -- | Presents right-associative folds as 'Foldable' sequences. module Proto3.Wire.FoldR+  {-# DEPRECATED "This module is no longer used by the rest of the proto3-wire package." #-}   ( FoldR(..)   , fromFoldR   ) where

@@ -1,5 +1,5 @@ {--  Copyright 2020 Awake Networks+  Copyright 2020-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -28,6 +28,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}  module Proto3.Wire.Reverse     ( -- * `BuildR` type@@ -105,13 +107,14 @@ import           Data.Vector.Generic           ( Vector ) import           Data.Word                     ( Word8, Word16, Word32, Word64 ) import           Foreign                       ( castPtr, copyBytes )-import           GHC.Exts                      ( Addr#, Int(..), Int# )+import           GHC.Exts                      ( Addr#, Int(..), Int#, Proxy#, proxy# ) #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           GHC.TypeLits                  ( KnownNat, natVal' )+import           Proto3.Wire.Encode.Repeated   ( ToRepeated, foldMapRepeated,+                                                 predictRepeated, toRepeated ) import           Proto3.Wire.Reverse.Internal import qualified Proto3.Wire.Reverse.Prim      as Prim @@ -871,7 +874,7 @@ -- -- See also: 'repeatedFixedPrimR', 'vectorBuildR' repeatedBuildR :: ToRepeated c BuildR => c -> BuildR-repeatedBuildR = etaBuildR (foldr (flip (<>)) mempty . reverseRepeated . toRepeated)+repeatedBuildR = etaBuildR (foldMapRepeated id) {-# INLINE repeatedBuildR #-}  -- | Concatenates the given fixed-width primitives, iterating right to left where practical@@ -883,12 +886,13 @@ -- [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+repeatedFixedPrimR :: forall c w . (ToRepeated c (Prim.FixedPrim w), KnownNat w) => c -> BuildR+repeatedFixedPrimR = etaBuildR $ \(toRepeated -> xs) -> case predictRepeated xs of+  Nothing ->+    foldMapRepeated (Prim.liftBoundedPrim . Prim.liftFixedPrim) xs+  Just c ->+    let w = fromInteger (natVal' (proxy# :: Proxy# w))+    in ensure (w * c) (foldMapRepeated (Prim.unsafeBuildBoundedPrim . Prim.liftFixedPrim) xs) {-# INLINE repeatedFixedPrimR #-}  -- | Exported for testing purposes only.

@@ -1,5 +1,5 @@ {--  Copyright 2020 Awake Networks+  Copyright 2020-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -19,17 +19,34 @@  {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}  module Proto3.Wire.Reverse.Internal-    ( BuildR (..)+    ( BuildM (BuildM)+    , buildMToBuildR#+    , buildRToBuildM#+    , buildMToBuildR+    , buildRToBuildM+    , BuildR (BuildR)     , BuildRState (..)     , appendBuildR     , foldlRVector+    , toBuildM+    , fromBuildM     , toBuildR     , fromBuildR     , etaBuildR+    , runBuildM     , runBuildR     , SealedState (SealedState, sealedSB, totalSB, stateVarSB, statePtrSB, recycledSB)     , sealBuffer@@ -40,7 +57,9 @@     , writeSpace     , metaDataSize     , metaDataAlign+    , readUnused     , withUnused+    , readUsed     , withTotal     , readTotal     , withLengthOf@@ -56,6 +75,9 @@     , doubleToWord64     ) where +#if !MIN_VERSION_base(4,18,0)+import           Control.Applicative           ( Applicative(..) )+#endif import           Control.Exception             ( bracket ) import           Control.Monad.Trans.State.Strict ( State, runState, state ) import qualified Data.ByteString               as B@@ -63,8 +85,10 @@ 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.Coerce                   ( coerce ) import           Data.IORef                    ( IORef, newIORef,                                                  readIORef, writeIORef )+import           Data.Kind                     ( Type ) import qualified Data.Primitive                as P import qualified Data.Vector.Generic           as VG import           Data.Vector.Generic           ( Vector )@@ -76,8 +100,8 @@                                                  deRefStablePtr ) import           GHC.Exts                      ( Addr#, Int#, MutVar#,                                                  RealWorld, StablePtr#, State#,-                                                 addrToAny#, int2Addr#,-                                                 touch# )+                                                 TYPE, addrToAny#, int2Addr#,+                                                 oneShot, touch# ) import           GHC.ForeignPtr                ( ForeignPtr(..),                                                  ForeignPtrContents(..) ) import           GHC.IO                        ( IO(..) )@@ -97,6 +121,90 @@ -- $setup -- >>> :set -XOverloadedStrings +-- | Like 'BuildR' but provides a way for builders to+-- return values monadically, not just emit octets.+#if defined(__GLASGOW_HASKELL__) && 904 <= __GLASGOW_HASKELL__+type BuildM :: forall {ar} . TYPE ar -> Type+#else+type BuildM :: forall ar . TYPE ar -> Type+#endif+newtype BuildM a+  -- | If you directly use this constructor, without also using 'oneShot',+  -- then the compiler may allocate a function object on the heap.  That+  -- is almost never desirable, because a 'B.ByteString' holding output+  -- of a builder tends to be a better way of memoizing an octet sequence.+  -- Use the pattern synonym @BuildM@ instead.+  = MemoBuildM (Addr# -> Int# -> State# RealWorld -> (# a, Addr#, Int#, State# RealWorld #))+      -- It seems we cannot preserve register allocation between the arguments+      -- and the returned components, even though we place the monadic return+      -- where it might sometimes replace the implicit closure argument (when+      -- its runtime representation uses one pointer register).+      --+      -- 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 components of+      -- the builder state between registers in many cases.  In this scenario,+      -- @a -> b -> 'BuildR'@ and 'BuildR' could 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.+      --+      -- Fortunately inlining erases this concern, and even where it+      -- does not, register movements often 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.+  deriving stock (Functor)++{-# COMPLETE BuildM #-}++-- ^ The arguments to the builder function 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).+--+-- The components of the returned unboxed tuple are the same, except+-- for the addition of the monadic return as the final component.+pattern BuildM ::+#if defined(__GLASGOW_HASKELL__) && 904 <= __GLASGOW_HASKELL__+  forall {ar} (a :: TYPE ar) .+#else+  forall ar (a :: TYPE ar) .+#endif+  (Addr# -> Int# -> State# RealWorld -> (# a, Addr#, Int#, State# RealWorld #)) ->+  BuildM a+pattern BuildM f <- MemoBuildM f+  where+    BuildM f = MemoBuildM (oneShot (\v -> oneShot (\u -> oneShot (\s -> f v u s))))++instance Applicative BuildM+  where+    pure a = BuildM (\v u s -> (# a, v, u, s #))++    BuildM f <*> BuildM x = BuildM+      ( \v0 u0 s0 -> case f v0 u0 s0 of+          (# g, v1, u1, s1 #) -> case x v1 u1 s1 of+            (# y, v2, u2, s2 #) -> (# g y, v2, u2, s2 #)+      )++    liftA2 f (BuildM x) (BuildM y) = BuildM+      ( \v0 u0 s0 -> case x v0 u0 s0 of+          (# w, v1, u1, s1 #) -> case y v1 u1 s1 of+            (# z, v2, u2, s2 #) -> (# f w z, v2, u2, s2 #)+      )++instance Monad BuildM+  where+    BuildM x >>= k = BuildM+      ( \v0 u0 s0 -> case x v0 u0 s0 of+          (# w, v1, u1, s1 #) -> let BuildM g = k w in g v1 u1 s1+      )+ -- | Writes bytes in reverse order, updating the current state. -- -- It is the responsibility of the execution context and buffer@@ -109,33 +217,92 @@ -- 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+-- or `Proto3.Wire.Encode.Repeated.foldMapRepeated` instead of 'foldMap'.+newtype BuildR = BuildRFromBuildM (BuildM (# #))++{-# COMPLETE BuildR #-}++-- | Converts a 'BuildM (# #)' into the equivalent 'BuildR' (currently without cost).+buildMToBuildR# :: BuildM (# #) -> BuildR+buildMToBuildR# = coerce++-- | Converts a 'BuildR' into the equivalent 'BuildM (# #)' (currently without cost).+buildRToBuildM# :: BuildR -> BuildM (# #)+buildRToBuildM# = coerce++-- | Like 'buildMToBuildR#' but uses a lifted unit type.+--+-- Ignores any distinction between terminating and non-terminating unit values.+buildMToBuildR :: BuildM () -> BuildR+buildMToBuildR = coerce+  ( ( \f -> oneShot+        (\v0 -> oneShot+          (\u0 -> oneShot+            (\s0 -> case f v0 u0 s0 of+                (# _ :: (), v1, u1, s1 #) -> (# (# #), v1, u1, s1 #)+            )+          )+        )+    )+    :: (Addr# -> Int# -> State# RealWorld -> (# (), Addr#, Int#, State# RealWorld #)) ->+       (Addr# -> Int# -> State# RealWorld -> (# (# #), Addr#, Int#, State# RealWorld #))+  )++-- | Like 'buildRToBuildM#' but uses a lifted unit type.+--+-- The returned unit value is always terminating.+buildRToBuildM :: BuildR -> BuildM ()+buildRToBuildM = coerce+  ( ( \f -> oneShot+        (\v0 -> oneShot+          (\u0 -> oneShot+            (\s0 -> case f v0 u0 s0 of+               (# (# #), v1, u1, s1 #) -> (# (), v1, u1, s1 #)+            )+          )+        )+    )+    :: (Addr# -> Int# -> State# RealWorld -> (# (# #), Addr#, Int#, State# RealWorld #)) ->+       (Addr# -> Int# -> State# RealWorld -> (# (), Addr#, Int#, State# RealWorld #))+  )++-- | This pattern synonym uses 'oneShot' as described in the comments for 'MemoBuildM'.+pattern BuildR ::+  (Addr# -> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #)) ->+  BuildR+pattern BuildR f <- (eliminateBuildR -> f)+  where+    BuildR f = introduceBuildR f++introduceBuildR ::+  (Addr# -> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #)) ->+  BuildR+introduceBuildR = coerce+  ( \(f :: (Addr# -> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #))) -> oneShot+      (\v0 -> oneShot+        (\u0 -> oneShot+          (\s0 -> case f v0 u0 s0 of+              (# v1, u1, s1 #) -> (# (# #), v1, u1, s1 #)+          )+        )+      )+  )+{-# INLINE introduceBuildR #-}++eliminateBuildR ::+  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.+eliminateBuildR = coerce+  ( \(f :: (Addr# -> Int# -> State# RealWorld -> (# (# #), Addr#, Int#, State# RealWorld #))) -> oneShot+      (\v0 -> oneShot+        (\u0 -> oneShot+          (\s0 -> case f v0 u0 s0 of+              (# (# #), v1, u1, s1 #) -> (# v1, u1, s1 #)+          )+        )+      )+  )+{-# INLINE eliminateBuildR #-}  instance Semigroup BuildR   where@@ -180,6 +347,16 @@   -- allocated, and instead we directly stream elements from right to left. {-# INLINE foldlRVector #-} +toBuildM :: (Ptr Word8 -> Int -> IO (Ptr Word8, Int, a)) -> BuildM a+toBuildM f =+  BuildM $ \v0 u0 s0 ->+    let IO g = f (Ptr v0) (I# u0) in+    case g s0 of (# s1, (Ptr v1, I# u1, a) #) -> (# a, v1, u1, s1 #)++fromBuildM :: BuildM a -> (Ptr Word8 -> Int -> IO (Ptr Word8, Int, a))+fromBuildM (BuildM f) (Ptr v0) (I# u0) =+  IO $ \s0 -> case f v0 u0 s0 of (# a, v1, u1, s1 #) -> (# s1, (Ptr v1, I# u1, a) #)+ toBuildR :: (Ptr Word8 -> Int -> IO (Ptr Word8, Int)) -> BuildR toBuildR f =   BuildR $ \v0 u0 s0 ->@@ -298,7 +475,8 @@ writeSpace :: Ptr MetaData -> Int -> IO () writeSpace m = pokeByteOff m spaceOffset --- | The arguments are the same as the 'BuildR' arguments.+-- | Reads the total bytes used across all buffers.+-- 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@@ -480,8 +658,25 @@             else finish (B.copy untrimmed) (Just buffer)  -- | Like `Proto3.Wire.Reverse.toLazyByteString` but also+-- reports the monadic return and the total length of the lazy+-- 'BL.ByteString', which is computed as a side effect of encoding.+--+-- See also 'runBuildR'.+runBuildM :: BuildM a -> (Int, BL.ByteString, a)+runBuildM 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, a) <- fromBuildM f v0 u0+    SealedState { sealedSB = bytes, totalSB = total } <- sealBuffer v1 u1+    pure (total, bytes, a)++-- | 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.+--+-- See also 'runBuildM'. runBuildR :: BuildR -> (Int, BL.ByteString) runBuildR f = unsafePerformIO $ do   stateVar <- newIORef undefined   -- undefined only until 'newBuffer'@@ -492,10 +687,20 @@     SealedState { sealedSB = bytes, totalSB = total } <- sealBuffer v1 u1     pure (total, bytes) +-- | Reads the number of unused bytes in the current buffer.+-- Note that reallocation provides more unused bytes.+readUnused :: BuildM Int+readUnused = BuildM (\v u s -> (# I# u, v, u, s #))+ -- | First reads the number of unused bytes in the current buffer.+-- Note that reallocation provides more unused bytes. withUnused :: (Int -> BuildR) -> BuildR withUnused f = toBuildR $ \v u -> fromBuildR (f u) v u +-- | Reads the total bytes used across all buffers.+readUsed :: BuildM Int+readUsed = toBuildM (\v u -> (v, u, ) <$> readTotal v u)+ -- | First reads the number of bytes previously written. withTotal :: (Int -> BuildR) -> BuildR withTotal f = withTotal# (\total -> f (I# total))@@ -695,10 +900,12 @@ 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+ensure# required (BuildR f) = BuildR $ \v0 u0 s0 ->+  let BuildR g+        | I# required <= I# u0 = mempty+        | otherwise = reallocate# required+  in case g v0 u0 s0 of+    (# v1, u1, s1 #) -> f v1 u1 s1  -- | 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,

@@ -1,5 +1,5 @@ {--  Copyright 2020 Awake Networks+  Copyright 2020-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -20,10 +20,12 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -111,7 +113,7 @@ import           Foreign                       ( Storable(..) ) import           GHC.Exts                      ( Addr#, Int#, Proxy#,                                                  RealWorld, State#, (+#),-                                                 and#, inline, or#,+                                                 and#, inline, oneShot, or#,                                                  plusAddr#, plusWord#, proxy#,                                                  uncheckedShiftRL# ) import           GHC.IO                        ( IO(..) )@@ -151,7 +153,7 @@  -- | Are we restricted to aligned writes only? data StoreMethod = StoreAligned | StoreUnaligned-  deriving (Eq, Show)+  deriving stock (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@@ -167,7 +169,7 @@ data ByteOrder   = BigEndian     -- ^ Most significant byte first.   | LittleEndian  -- ^ Least significant byte first.-  deriving (Eq, Show)+  deriving stock (Eq, Show)  -- | The 'ByteOrder' native to the current architecture. --@@ -304,11 +306,23 @@ -- -- (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 #)-  )+newtype FixedPrim (w :: Nat) =+  -- | If you directly use this constructor, without also using 'oneShot',+  -- then the compiler may allocate a function object on the heap.  That+  -- is almost never desirable, especially for primitive combinators.+  MemoFixedPrim (Addr# -> Int# -> State# RealWorld -> Int# -> (# Addr#, Int#, State# RealWorld #)) +{-# COMPLETE FixedPrim #-}++-- | This pattern synonym uses 'oneShot' as described in the comments for 'FixedPrim'.+pattern FixedPrim ::+  (Addr# -> Int# -> State# RealWorld -> Int# -> (# Addr#, Int#, State# RealWorld #)) ->+  FixedPrim w+pattern FixedPrim f <- MemoFixedPrim f+  where+    FixedPrim f = MemoFixedPrim+      (oneShot (\v -> oneShot (\u -> oneShot (\s -> oneShot (\o -> f v u s o)))))+ type role FixedPrim nominal  type instance PNullary FixedPrim width = FixedPrim width@@ -343,12 +357,13 @@  -- | 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 #-}+liftFixedPrim = \(FixedPrim f) ->+  let !(I# o) = - fromInteger (natVal' (proxy# :: Proxy# w))+      g = \v0 u0 s0 -> case f v0 u0 s0 o of+        (# v1, u1, s1 #) -> (# plusAddr# v1 o, u1 +# o, s1 #)+      {-# INLINE g #-}+  in+    BoundedPrim (BuildR g) {-# INLINE CONLIKE [1] liftFixedPrim #-}  {-# RULES@@ -404,11 +419,11 @@  -- | 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 =+primPoke !x = FixedPrim+  ( \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@@ -584,24 +599,24 @@ -- | 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+floatBE !x = FixedPrim+  ( \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+floatLE !x = FixedPrim+  ( \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.@@ -617,24 +632,24 @@ -- | 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+doubleBE !x = FixedPrim+  ( \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+doubleLE !x = FixedPrim+  ( \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.@@ -872,3 +887,5 @@   where     w = fromInteger (natVal' (proxy# :: Proxy# w)) {-# INLINE unsafeReverseFoldMapFixedPrim #-}+{-# DEPRECATED unsafeReverseFoldMapFixedPrim+                 "This function is no longer used by the rest of the proto3-wire package." #-}

@@ -1,10 +1,11 @@ {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DeriveLift                 #-}+{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  {--  Copyright 2016 Awake Networks+  Copyright 2016-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -44,7 +45,8 @@ -- left to other, higher-level libraries. newtype FieldNumber = FieldNumber   { getFieldNumber :: Word64 }-  deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Lift, NFData, Num, Ord)+  deriving stock (Data, Generic, Lift)+  deriving newtype (Bounded, Enum, Eq, Hashable, NFData, Num, Ord)  instance Show FieldNumber where   show (FieldNumber n) = show n@@ -64,4 +66,4 @@   | Fixed32   | Fixed64   | LengthDelimited-  deriving (Bounded, Data, Enum, Eq, Generic, Lift, Ord, Show)+  deriving stock (Bounded, Data, Enum, Eq, Generic, Lift, Ord, Show)

@@ -1,5 +1,5 @@ {--  Copyright 2016 Awake Networks+  Copyright 2016-2026 Awake Networks    Licensed under the Apache License, Version 2.0 (the "License");   you may not use this file except in compliance with the License.@@ -14,11 +14,17 @@   limitations under the License. -} +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  {-# OPTIONS_GHC -Wno-warnings-deprecations #-} @@ -34,13 +40,13 @@ import qualified Data.ByteString.Short as BS import qualified Data.ByteString.Builder.Internal as BBI import           Data.Either           ( isLeft )-import           Data.Foldable         ( toList )+import           Data.Foldable 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.Maybe            ( fromMaybe, mapMaybe ) import           Data.List             ( sort ) import qualified Data.List.NonEmpty    as NE import           Data.Proxy            ( Proxy(..) )@@ -52,17 +58,23 @@ 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           Data.Word             ( Word8, Word16, Word32, Word64 ) import           Foreign               ( sizeOf ) import qualified GHC.Exts+import           Text.Read             ( readEither )  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 Proto3.Wire.Encode    as Encode+import           Proto3.Wire.Encode.Repeated+                                       ( Count(..), Repeated, Reverse(..), ToRepeated(..),+                                         foldMapRepeated, foldMapRepeated', foldlRepeated,+                                         foldrRepeated', mapFoldRepeated, mapMaybeRepeated,+                                         mapRepeated, nullRepeated, predictRepeated, toRepeated )+import qualified Proto3.Wire.Reverse   as Reverse+import qualified Proto3.Wire.Reverse.Internal as Reverse+import           Proto3.Wire.Types     ( WireType(..) )  import qualified Test.DocTest import           Test.QuickCheck       ( (===), Arbitrary )@@ -84,7 +96,8 @@     defaultMain tests  tests :: TestTree-tests = testGroup "Tests" [ roundTripTests+tests = testGroup "Tests" [ buildMTests+                          , roundTripTests                           , buildSingleChunk                           , buildRBufferSizes                           , strictByteString@@ -96,8 +109,68 @@                           , toRepeatedTests                           ] +buildMTests :: TestTree+buildMTests = testGroup "BuildM tests"+  [ QC.testProperty "buildRToBuildM" $+      QC.forAll QC.arbitrary $ \x ->+        Reverse.runBuildM (Reverse.buildRToBuildM (Reverse.word8 x)) === (1, BL.singleton x, ())+  , QC.testProperty "buildMToBuildR" $+      QC.forAll QC.arbitrary $ \x ->+        Reverse.runBuildR (Reverse.buildMToBuildR (Reverse.buildRToBuildM (Reverse.word8 x)))+          === (1, BL.singleton x)+  , QC.testProperty "Applicative BuildM" $+      QC.forAll QC.arbitrary $ \x ->+      QC.forAll QC.arbitrary $ \y ->+        let w8 = Reverse.buildRToBuildM . Reverse.word8+            pureB = pure x+            applyB = ((y -) <$ w8 y) <*> (x <$ w8 x)+        in+          Reverse.runBuildM pureB === (0, mempty, x) QC..&&.+          Reverse.runBuildM applyB === (2, BL.pack [x, y], y - x)+  , QC.testProperty "Monad BuildM" $+      QC.forAll QC.arbitrary $ \x ->+      QC.forAll QC.arbitrary $ \y ->+        let w8 = Reverse.buildRToBuildM . Reverse.word8+            bindB = (y <$ w8 y) >>= \z -> (z - x) <$ w8 x+        in+          Reverse.runBuildM bindB === (2, BL.pack [x, y], y - x)+  , QC.testProperty "toBuildM . fromBuildM" $+      QC.forAll QC.arbitrary $ \x ->+        let builder :: Reverse.BuildM Word16+            builder = Reverse.toBuildM . Reverse.fromBuildM $+                        (x + 5) <$ Reverse.buildRToBuildM (Reverse.word16BE x)+        in+          Reverse.runBuildM builder ===+            (2, BL.pack [fromIntegral (x `quot` 256), fromIntegral (x `rem` 256)], x + 5)+  , QC.testProperty "readUsed" $+      QC.forAll QC.arbitrary $ \x ->+      QC.forAll QC.arbitrary $ \y ->+        let w8 = Reverse.buildRToBuildM . Reverse.word8+            builder = do+              w8 y+              u <- Reverse.readUsed+              w8 x+              v <- Reverse.readUsed+              pure (u, v)+        in+          Reverse.runBuildM builder === (2, BL.pack [x, y], (1, 2))+  , QC.testProperty "readUnused" $+      QC.forAll QC.arbitrary $ \x ->+      QC.forAll QC.arbitrary $ \y ->+        let w8 = Reverse.buildRToBuildM . Reverse.word8+            builder = do+              w8 y+              u <- Reverse.readUnused+              w8 x+              v <- Reverse.readUnused+              pure (u, v)+        in+          Reverse.runBuildM builder+            === (2, BL.pack [x, y], (Reverse.smallChunkSize - 1, Reverse.smallChunkSize - 2))+  ]+ data StringOrInt64 = TString T.Text | TInt64 Int64-    deriving (Show,Eq)+    deriving stock (Eq, Show)  instance QC.Arbitrary StringOrInt64 where     arbitrary = QC.oneof [ TString . T.pack <$> QC.arbitrary, TInt64 <$> QC.arbitrary ]@@ -181,7 +254,15 @@                                                                    0 `at`                                                                    fieldNumber 1))                                             `at` fieldNumber 1)-                           , roundTrip "embeddedListPackedVarints"+                           , roundTrip "embeddedIfNonempty"+                                       (Encode.embeddedIfNonempty (fieldNumber 1) .+                                            Encode.int32 (fieldNumber 2))+                                       (fmap (fromMaybe 0)+                                             (Decode.embedded (one Decode.int32+                                                                   0 `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedVarints - Function"                                        (Encode.embedded (fieldNumber 1) .                                             Encode.packedVarints (fieldNumber 1))                                        (fmap (fromMaybe [0,1,2,3,4])@@ -189,38 +270,111 @@                                                                    `at`                                                                    fieldNumber 1))                                             `at` fieldNumber 1)-                           , roundTrip "embeddedListPackedFixed32"+                           , roundTrip "embeddedListPackedVarints - Method Word64"                                        (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Varint @[Word64] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedVarints - Method Word32"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Varint @[Word32] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedVarints - Method Word16"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Varint @[Word16] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedVarints - Method Word8"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Varint @[Word8] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedVarints - Method Bool"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Varint @[Bool] (fieldNumber 2))+                                       (fmap (fromMaybe [False,True,False,True,False])+                                             (fmap (map ((0 :: Int32) /=)) <$>+                                              Decode.embedded (one Decode.packedVarints []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFixed32 - Function"+                                       (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"+                           , roundTrip "embeddedListPackedFixed32 - Method Word32"                                        (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Fixed32 @[Word32] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedFixed32 []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFixed64 - Function"+                                       (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"+                           , roundTrip "embeddedListPackedFixed64 - Method Word64"                                        (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Fixed64 @[Word64] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedFixed64 []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedFloats - Function"+                                       (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"+                           , roundTrip "embeddedListPackedFloats - Method Float"                                        (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Fixed32 @[Float] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedFloats []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)+                           , roundTrip "embeddedListPackedDoubles - Function"+                                       (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 "embeddedListPackedDoubles - Method Double"+                                       (Encode.embedded (fieldNumber 1) .+                                            Encode.packedField @'Fixed64 @[Double] (fieldNumber 2))+                                       (fmap (fromMaybe [0,1,2,3,4])+                                             (Decode.embedded (one Decode.packedDoubles []+                                                                   `at`+                                                                   fieldNumber 2))+                                            `at` fieldNumber 1)                            , roundTrip "embeddedListUnpacked"                                        (Encode.embedded (fieldNumber 1) .                                             (foldMap . Encode.int32) (fieldNumber 1))@@ -278,7 +432,7 @@         \x ->             let bytes = Encode.toLazyByteString (encode x) in             case Decode.parse decode (BL.toStrict bytes) of-                Left _ -> error "Could not decode encoded message"+                Left e -> error $ "Could not decode encoded message: " ++ show e                 Right x' -> x === x'  genManyOctets :: QC.Gen [Word8]@@ -801,12 +955,27 @@                              (BL.toStrict encoded)   HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded -data ExpectedCountPrediction c = NoCP | CorrectCP | SameCP (c -> Maybe Int)+data ExpectedCountPrediction c = NoCP | CorrectCP  toRepeatedTests :: TestTree toRepeatedTests = testGroup "ToRepeated"-  [ test_nullRepeated-  , test_ToRepeated (SameCP countRepeated) genRepeated (reverse . toList . reverseRepeated)+  [ test_genRepeated+  , test_Eq_Repeated+  , test_Show_Repeated+  , test_Read_Repeated+  , test_IsList_Repeated+  , test_Functor_Repeated+  , test_nullRepeated+  , test_predictRepeated+  , test_foldMapRepeated+  , test_foldMapRepeated'+  , test_foldlRepeated+  , test_foldrRepeated'+  , test_toRepeated+  , test_mapRepeated+  , test_mapMaybeRepeated+  , test_mapFoldRepeated+  , test_ToRepeated_Repeated   , 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)@@ -818,55 +987,340 @@   , 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)+  , test_RULES_toRepeated_Repeated   ]++data TestSequenceNE e = LeafSequenceNE e | NodeSequenceNE (TestSequenceNE e) (TestSequenceNE e)++data TestSequence e = TestSequence (Maybe Int) (Maybe (TestSequenceNE e))++instance ToRepeated (TestSequence e) e   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-        }+    predictRepeatedSource (TestSequence maybeCount _) = maybeCount+    {-# INLINE predictRepeatedSource #-} -    test_nullRepeated :: TestTree-    test_nullRepeated =-      QC.testProperty "nullRepeated" $-        QC.forAll genRepeated $ \c ->-          nullRepeated c === null (reverseRepeated c)+    foldMapRepeatedSource _ (TestSequence _ Nothing) = mempty+    foldMapRepeatedSource f (TestSequence _ (Just xs)) = go xs+      where+        go (LeafSequenceNE x) = f x+        go (NodeSequenceNE l r) = go l <> go r+    {-# INLINE foldMapRepeatedSource #-} -    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+instance ToRepeated (Reverse (TestSequence e)) e+  where+    predictRepeatedSource (Reverse (TestSequence maybeCount _)) = maybeCount+    {-# INLINE predictRepeatedSource #-} -              prediction :: Maybe Int-              reversed :: FoldR e-              ReverseRepeated prediction reversed = toRepeated c+    foldMapRepeatedSource _ (Reverse (TestSequence _ Nothing)) = mempty+    foldMapRepeatedSource f (Reverse (TestSequence _ (Just xs))) = go xs+      where+        go (LeafSequenceNE x) = f x+        go (NodeSequenceNE l r) = go r <> go l+    {-# INLINE foldMapRepeatedSource #-}++toNonEmptyTestSequenceNE :: TestSequenceNE e -> NE.NonEmpty e+toNonEmptyTestSequenceNE = \case+  LeafSequenceNE x -> x NE.:| []+  NodeSequenceNE l r -> toNonEmptyTestSequenceNE l <> toNonEmptyTestSequenceNE r++-- NOTE: Does not preserve order, nor does it need to preserve+-- order because we use it only during random generation.+splitAndReorderTestSequenceNE :: NE.NonEmpty e -> QC.Gen (TestSequenceNE e)+splitAndReorderTestSequenceNE (x NE.:| []) = pure (LeafSequenceNE x)+splitAndReorderTestSequenceNE (y NE.:| z : xs) = do+  index <- QC.choose (0, length xs)+  let (ys, zs) = splitAt index xs+  NodeSequenceNE+    <$> splitAndReorderTestSequenceNE (y NE.:| ys)+    <*> splitAndReorderTestSequenceNE (z NE.:| zs)++toListTestSequence :: Maybe (TestSequenceNE e) -> [e]+toListTestSequence = maybe [] (NE.toList . toNonEmptyTestSequenceNE)++splitAndReorderTestSequence :: [e] -> QC.Gen (Maybe (TestSequenceNE e))+splitAndReorderTestSequence [] = pure Nothing+splitAndReorderTestSequence (x : xs) = Just <$> splitAndReorderTestSequenceNE (x NE.:| xs)++genTestSequence :: QC.Arbitrary e => QC.Gen (TestSequence e)+genTestSequence = do+  xs <- QC.arbitrary+  ys <- splitAndReorderTestSequence xs+  predict <- QC.arbitrary+  pure $ TestSequence (if predict then (Just (length (toListTestSequence ys))) else Nothing) ys++-- | Generates a list of words and a 'Repeated' containing those same words in the same+-- order, sometimes with a length prediction and sometimes without a length prediction.+-- Also reports any count prediction that we expect to be made by the generated 'Repeated'.+genRepeated :: QC.Gen (Maybe Int, [Word8], Repeated Word8)+genRepeated = do+  (xs :: TestSequence Int8) <- genTestSequence+  let TestSequence maybeCount (toListTestSequence -> ys) = xs+  oddFactor <- (1 Bits..|.) <$> QC.arbitrary+  f <- QC.frequency+    [ (2, pure (Left ((oddFactor *) . fromIntegral)))+    , (1, pure (Right (\(fromIntegral -> x) -> if mod x 3 == 0 then [] else [oddFactor * x])))+    , (1, pure (Right (\(fromIntegral -> x) -> if mod x 3 == 1 then [] else [oddFactor * x, x])))+    ]+  pure $ case f of+    Left g -> (maybeCount, map g ys, mapRepeated g xs)+    Right g -> (Nothing, concatMap g ys, mapFoldRepeated (\j -> foldMap j . g) xs)++-- | Performs basic validation of a value of type 'Repeated' against+-- the information it is expected to contain.  While these checks+-- are sometimes redundant with the checks made by particular tests,+-- it is probably better to check redundantly than to omit a check,+-- and the extra time required for these particular checks is tiny.+validateRepeated :: (Eq e, Show e) => Maybe Int -> [e] -> Repeated e -> QC.Property+validateRepeated expectedMaybeCount expectedElements xr =+  foldMapRepeatedSource (: []) xr === expectedElements+  QC..&&.+  predictRepeated xr === expectedMaybeCount+  QC..&&.+  case expectedMaybeCount of+    Nothing -> QC.property True+    Just n -> n === length expectedElements++-- NOTE: This test verifies the test infrastructure against itself.+-- It is not intended to check the code under test.+test_genRepeated :: TestTree+test_genRepeated =+  QC.testProperty "genRepeated" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+      validateRepeated xc xs xr++test_Eq_Repeated :: TestTree+test_Eq_Repeated =+  QC.testProperty "Eq (Repeated Word8)" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll genRepeated $ \(_, ys, yr) ->+      (xr == yr) === (xs == ys)++test_Show_Repeated :: TestTree+test_Show_Repeated =+  QC.testProperty "Show (Repeated Word8)" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll (QC.choose (0, 12)) $ \d ->+      showsPrec d xr "xyz" === showsPrec d xs "xyz"++test_Read_Repeated :: TestTree+test_Read_Repeated =+  QC.testProperty "Read (Repeated Word8)" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+      readEither (show xs) === Right xr  -- can consume expected form+      QC..&&.+      readEither (show xr) === Right xr  -- round trip with 'show'++test_IsList_Repeated :: TestTree+test_IsList_Repeated =+  QC.testProperty "IsList (Repeated Word8)" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+      QC.counterexample "GHC.Exts.toList"+        (GHC.Exts.toList xr === xs)+      QC..&&.+      QC.counterexample "GHC.Exts.fromList"+        ( let xr' = GHC.Exts.fromList xs           in-            QC.counterexample "correctly reversed elements" (toList reversed === reverse es)+            validateRepeated Nothing xs xr'             QC..&&.-            QC.counterexample "correct count prediction if any"-              (all @Maybe (== length es) prediction)+            xr' === xr             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)+            predictRepeated xr' === Nothing+        )+      QC..&&.+      QC.counterexample "GHC.Exts.fromListN"+        ( let n = length xs+              xr' = GHC.Exts.fromListN n xs+          in+            validateRepeated (Just n) xs xr'+            QC..&&.+            xr' === xr+            QC..&&.+            predictRepeated xr' === Just n+        )++test_Functor_Repeated :: TestTree+test_Functor_Repeated =+  QC.testProperty "Functor Repeated" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      GHC.Exts.toList (fmap (pivot -) xr) === map (pivot -) xs+      QC..&&.+      predictRepeated (fmap (pivot -) xr) === xc++test_nullRepeated :: TestTree+test_nullRepeated =+  QC.testProperty "nullRepeated" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+      nullRepeated xr === null xs++test_predictRepeated :: TestTree+test_predictRepeated =+  QC.testProperty "predictRepeated" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+    QC.forAll QC.arbitrary $ \probablyIncorrectCount ->+      let f y = pivot - y+          g y+            | even y = Nothing+            | otherwise = Just (pivot - y)+      in+        predictRepeated (mapRepeated f xr) === xc+        QC..&&.+        predictRepeated (mapMaybeRepeated g xr) === Nothing+        QC..&&.+        predictRepeated (UnsafeCount probablyIncorrectCount xs) === Just probablyIncorrectCount++test_foldMapRepeated :: TestTree+test_foldMapRepeated =+  QC.testProperty "foldMapRepeated" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f y = [pivot - y]+      in+        GHC.Exts.toList (foldMapRepeated f xr) === foldMap f xs++-- NOTE: Does not currently attempt to test strictness.+test_foldMapRepeated' :: TestTree+test_foldMapRepeated' =+  QC.testProperty "foldMapRepeated'" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f y = [pivot - y]+      in+        GHC.Exts.toList (foldMapRepeated' f xr) === foldMap' f xs++test_foldlRepeated :: TestTree+test_foldlRepeated =+  QC.testProperty "foldlRepeated" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f a y = pivot - y : a+      in+        GHC.Exts.toList (foldlRepeated f [] xr) === foldl f [] xs++-- NOTE: Does not currently attempt to test strictness.+test_foldrRepeated' :: TestTree+test_foldrRepeated' =+  QC.testProperty "foldrRepeated'" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f y a = pivot - y : a+      in+        GHC.Exts.toList (foldrRepeated' f [] xr) === foldr' f [] xs++test_toRepeated :: TestTree+test_toRepeated =+  QC.testProperty "toRepeated" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+      GHC.Exts.toList (toRepeated xr) === xs+      QC..&&.+      predictRepeated (toRepeated xr) === xc++test_mapRepeated :: TestTree+test_mapRepeated =+  QC.testProperty "mapRepeated" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      GHC.Exts.toList (mapRepeated (pivot -) xr) === map (pivot -) xs+      QC..&&.+      predictRepeated (mapRepeated (pivot -) xr) === xc++test_mapMaybeRepeated :: TestTree+test_mapMaybeRepeated =+  QC.testProperty "mapMaybeRepeated" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f y+            | even y = Nothing+            | otherwise = Just (pivot - y)+      in+        GHC.Exts.toList (mapMaybeRepeated f xr) === mapMaybe f xs+        QC..&&.+        predictRepeated (mapMaybeRepeated f xr) === Nothing+        QC..&&.+        -- Verify a related identity from the documentation for 'mapFoldRepeated':+        mapMaybeRepeated f xr === mapFoldRepeated (\h -> foldMap h . f) xr++test_mapFoldRepeated :: TestTree+test_mapFoldRepeated =+  QC.testProperty "mapFoldRepeated" $+    QC.forAll genRepeated $ \(_, xs, xr) ->+    QC.forAll QC.arbitrary $ \pivot ->+      let f y = case mod y 3 of+            0 -> [pivot - y]+            1 -> [pivot - y, y]+            _ -> []+          g j y = foldMap j (f y)+      in+        GHC.Exts.toList (mapFoldRepeated g xr) === concatMap f xs+        QC..&&.+        predictRepeated (mapFoldRepeated g xr) === Nothing++test_ToRepeated_Repeated :: TestTree+test_ToRepeated_Repeated =+  QC.testProperty "ToRepeated (Repeated Word8) Word8" $+    QC.forAll genRepeated $ \(xc, xs, xr) ->+      validateRepeated xc xs xr+      QC..&&.+      QC.counterexample "correctly ordered elements" (foldMapRepeated (: []) xr === xs)+      QC..&&.+      QC.counterexample "expected count prediction" (predictRepeated xr === xc)++test_ToRepeated ::+  forall c e .+  ( ToRepeated c e+  , ToRepeated (Reverse c) e+  , Show c+  , Typeable c+  , Typeable e+  , Eq e+  , Ord e+  , Show e+  ) =>+  ExpectedCountPrediction c ->+  (QC.Gen c) ->+  (c -> [e]) ->+  TestTree+test_ToRepeated expectedCP gen cToList =+  let cRep = typeRep (Proxy :: Proxy c)+      eRep = typeRep (Proxy :: Proxy e)+      testName = showString "ToRepeated " $ showsTypeRep cRep $ showChar ' ' $ showsTypeRep eRep ""+  in QC.testProperty testName $+    QC.forAll gen $ \(c :: c) ->+      let xs :: [e]+          xs = cToList c+          xr, rr :: Repeated e+          xr = toRepeated c+          rr = toRepeated (Reverse c)+          expectedMaybeCount :: Maybe Int+          expectedMaybeCount = case expectedCP of+            NoCP -> Nothing+            CorrectCP -> Just (length xs)+      in+        QC.counterexample "correctly ordered elements" (foldMapRepeated (: []) c === xs)+        QC..&&.+        QC.counterexample "correct count prediction if any"+          (all @Maybe (== length xs) (predictRepeated xr))+        QC..&&.+        QC.counterexample "expected count prediction" (predictRepeated xr === expectedMaybeCount)+        QC..&&.+        QC.counterexample "valid result from toRepeated" (validateRepeated expectedMaybeCount xs xr)+        QC..&&.+        QC.counterexample "correctly reversed elements" (foldMapRepeated (: []) rr === reverse xs)+        QC..&&.+        QC.counterexample "same count prediction when reversed"+          (predictRepeated rr === predictRepeated xr)+        QC..&&.+        QC.counterexample "valid result from reverseRepeated"+          (validateRepeated expectedMaybeCount (reverse xs) rr)++test_RULES_toRepeated_Repeated :: TestTree+test_RULES_toRepeated_Repeated =+  QC.testProperty "RULES toRepeated@Repeated" $+    QC.forAll genRepeated $ \(_, _, xr :: Repeated Word8) ->+      toRepeated xr === toRepeated_NOINLINE xr++-- | @NOINLINE@ and still polymorphic in order to avoid triggering rewrite rules.+toRepeated_NOINLINE :: ToRepeated c e => c -> Repeated e+toRepeated_NOINLINE = toRepeated+{-# NOINLINE toRepeated_NOINLINE #-}